home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / vis082s.arc / MYCOMMAN.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-17  |  74KB  |  2,637 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2.  
  3. unit mycomman;
  4.  
  5. interface
  6.  
  7. uses crt,dos,
  8. gentypes,configrt,modem,statret,gensubs,subs1,windows,subs2,textret,
  9.      mailret,userret,flags,mainr1,ansiedit,lineedit,
  10.      mainr2,overret1;
  11.  
  12. procedure nodelists;
  13. procedure mycommand;
  14. procedure localconfiguration;
  15. procedure showsystemstatus;
  16. procedure loozerlists;
  17. procedure listusers;
  18. procedure transfername;
  19. procedure editnews;
  20. procedure delerrlog;
  21. procedure feedback;
  22. procedure settime;
  23. procedure changepwd;
  24. procedure requestraise;
  25. procedure leechlist;
  26. procedure timebanks;
  27. procedure makeuser;
  28. procedure infoformhunt;
  29. procedure donations;
  30. procedure viewsyslog;
  31. procedure delsyslog;
  32. procedure showallforms;
  33. procedure mainhelp;
  34. procedure otherbbs;
  35. procedure readerrlog;
  36. procedure showad;
  37. procedure setlastcall;
  38. procedure removeallforms;
  39. procedure showscreens;
  40. Procedure showlastcallers;
  41. Procedure JumpConference;
  42. Procedure TopTen(eatshit:byte);
  43. Procedure DisplayNodeInfo;
  44. Procedure AddNews;
  45. Procedure RumorMenu;
  46. Procedure RandomRumor;
  47. Procedure Get_Infoform;
  48. Procedure UserCheck;
  49.  
  50. implementation
  51.  
  52. Procedure addnews;
  53.         Var newline,r:Integer;
  54.             nfile:File Of newsrec;
  55.             ntmp,atmp:newsrec;
  56.             numnews,cnt:Integer;
  57.             m:message;
  58.             t:text;
  59.         Begin
  60.             writehdr('Adding to the news');
  61.             Writestr('Minimum Level to read news [1] :');
  62.             If Input='' Then Input:='1';
  63.             ntmp.level := Valu (input);
  64.             Writestr('Maximum Level to read news [32767] :*');
  65.             If Input='' Then Input:='32767';
  66.             ntmp.maxlevel:=valu(Input);
  67.             newline:=editor(m,false,true,'0','0');
  68.             Ntmp.when:=now;ntmp.from:=unam;Ntmp.title:=m.title;
  69.             ntmp.location:=newline;
  70.             If newline<0 Then exit;
  71.             r:=IOResult;
  72.             Assign(nfile,'News');
  73.             Reset(nfile);
  74.             r:=IOResult;
  75.             If r<>0
  76.             Then
  77.                 Begin
  78.                     If r<>1 Then WriteLn('Error ',r,' opening news file; recreating.');
  79.                     Rewrite(nfile);
  80.                     Write(nfile,ntmp);
  81.                     numnews:=0
  82.                 End
  83.             Else
  84.                 Begin
  85.                     numnews:=FileSize(nfile);
  86.                     For cnt:=numnews-1 Downto 0 Do
  87.                         Begin
  88.                             Seek(nfile,cnt);
  89.                             Read(nfile,atmp);
  90.                             Seek(nfile,cnt+1);
  91.                             Write(nfile,atmp)
  92.                         End;
  93.                     che;
  94.                     Seek(nfile,0);
  95.                     Write(nfile,Ntmp)
  96.                 End;
  97.             WriteLn('News added.  News items: ',numnews+1);
  98.             writelog(2,1,'');
  99.             Close(nfile);
  100.     end;
  101.  
  102. procedure mycommand;
  103. begin
  104.   clearscr;
  105.   if ansigraphics in urec.config then begin
  106.     blowup(4,2,60,7);
  107.     printxy(4,4,^R'[ '^P'ViSiON BBS Credits'^R' ]');
  108.     printxy(5,4,'ViSiON BBS Software is brought to you by:');
  109.     printxy(6,4,'    Crimson Blade and The Elemental');
  110.     printxy(8,4,' We can be contacted on the ViSiON Home Board:');
  111.     printxy(9,4,'   Countdown to Chaos  -  (619)868-2025');
  112.     blowup(11,20,50,11);
  113.     printxy(12,22,'Alot of thanx to the following:');
  114.     printxy(13,22,'  The Spectral Demon - Ideas/Menus/Doc''s');
  115.     printxy(14,22,'  Melkor - Ideas/Beta Testing');
  116.     Printxy(15,22,'  Xerxes - Beta Testing/Staff');
  117.     Printxy(16,22,'  Amplitude - ViSiON Spittle');
  118.     printxy(17,22,'  Sickler - Beta Testing');
  119.     printxy(18,22,'  The Byter - Inspiration and CHAT!');
  120.     printxy(19,22,'  THE SLAVELORD and Low Rider...');
  121.     printxy(20,22,'  Thanx for making this happen....');
  122.     goxy (1,23);
  123.   end else begin
  124.     writeln('                             -=-=-= ViSiON BBS Credits =-=-=-');
  125.     writeln(^M'ViSiON BBS Software brought to you by:');
  126.     writeln('   Crimson Blade & The Elemental');
  127.     writeln(^M'Alot of Thanks to the following: (not in any particular ORDER!)');
  128.     writeln('  The Spectral Demon - Ideas/Menus/Documentation');
  129.     writeln('  Melkor             - Ideas/Beta Testing');
  130.     writeln('  Sickler            - Beta Testing');
  131.     writeln('  The Byter          - Inspiration and Chat');
  132.     writeln('  THE SLAVELORD      - Ideas/Inspiration, and Thanx.'^M^M);
  133.     writeln('               ViSiON can be seen/obtained on');
  134.     writeln('           Countdown to Chaos - (619)868-2025 / ViSiON Home');
  135.   end;
  136. end;
  137.  
  138. procedure localconfiguration;
  139. var tp1,tp2:lstr;
  140.     q,tp:integer;
  141.     fn:file of configsettype;
  142.  
  143. function sellitout(t2:lstr):lstr;
  144. begin
  145. writestr(^P'Enter the new '^R+t2+^P' for your BBS [Ret=No Change]:');
  146. sellitout:=input;
  147. end;
  148.  
  149. begin
  150. repeat
  151. q:=menu('Local Configuration','CONFIGL','SPMTUANHFCVLQ');
  152. case q of
  153.  1:begin
  154.    tp1:=sellitout('SHORTNAME');
  155.    if (tp1<>'') then configset.shortnam:=tp1;
  156.    writelog(21,1,configset.shortnam);
  157.    end;
  158.  2:begin
  159.    tp1:=sellitout('SYSTEM PASSWORD');
  160.     if (TP1)<>'' then configset.systempasswor:=tp1;
  161.     writelog(21,2,configset.systempasswor);
  162.     end;
  163.  3:begin
  164.     writestr(^P'Enter your new Matrix Type (0=none,1=standard,2=DOS,3=Custom) [Ret=No Change]:');
  165.     if input<>'' then tp:=valu(input) else tp:=configset.matrixtyp;
  166.     if (tp<0) or (tp>3) then begin
  167.        writeln(^M'Thats an invalid range!');
  168.        tp:=configset.matrixtyp;
  169.     end;
  170.     configset.matrixtyp:=tp;
  171.     writelog(21,3,strr(configset.matrixtyp));
  172.     end;
  173.  4:begin
  174.     tp1:=sellitout('SYSOP PASSWORD');
  175.     if (tp1<>'') then configset.sysop:=tp1;
  176.     writelog(21,4,configset.sysop);
  177.    end;
  178.  5:Begin
  179.    tp1:=sellitout('TIME REFUND');
  180.     if (tp1<>'') then tp:=valu(tp1) else tp:=configset.timepercentbac;
  181.     configset.timepercentbac:=tp;
  182.     writelog(21,5,strr(tp));
  183.    end;
  184.  6:Begin
  185.    writestr(^P'Allow new users ? *');
  186.    if yes then configset.privat:=false else configset.privat:=true;
  187.    if configset.privat then writelog(21,6,'No') else writelog(21,6,'Yes');
  188.    end;
  189.  7:Begin
  190.    tp1:=sellitout('NEW USER PASSWORD');
  191.    if (tp1<>'') then configset.newuserpas:=tp1;
  192.    if match(tp1,'N') then configset.newuserpas:='';
  193.    writelog(21,7,configset.newuserpas);
  194.    end;
  195.  8:Begin
  196.     tp1:=sellitout('LOGIN HEADER');
  197.     if (tp1<>'') then configset.loginheade:=tp1;
  198.     writelog(21,8,configset.loginheade);
  199.     end;
  200.  9:Begin
  201.     writestr(^P'Allow feedback from the Matrix ? *');
  202.     configset.feedmatr:=yes;
  203.     if yes then writelog(21,9,'Yes') else writelog(21,9,'No');
  204.    end;
  205.  10:begin
  206.      writestr(^P'Allow paging from the matrix ? *');
  207.      configset.chatmatr:=yes;
  208.      if yes then writelog(21,10,'Yes') else writelog(21,10,'No');
  209.      end;
  210.  11:Begin
  211.     clearscr;
  212.     writeln(^P'Status for '+^R+configset.longnam+^P+' registered to '+^R+registo);
  213.     writeln;
  214.     Tab(^P'Shortname',30);
  215.     writeln(':'^R+configset.shortnam);
  216.     tab(^P'Matrix type',30);
  217.     writeln(':'^R+strr(configset.matrixtyp));
  218.     tab(^P'Upload Time back',30);
  219.     writeln(':'^R+strr(configset.timepercentbac));
  220.     tab(^P'System Password',30);
  221.     writeln(':'^R+configset.systempasswor);
  222.     tab(^P'SysOp Password',30);
  223.     writeln(':'^R+configset.sysop);
  224.     tab(^P'Allow New Users',30);
  225.     write(':'^R); if configset.privat then writeln('No') else writeln('Yes');
  226.     tab(^P'New User Password',30);
  227.     writeln(':'^R+configset.newuserpas);
  228.     tab(^P'Login Header',30);
  229.     writeln(':'^R+configset.loginheade);
  230.     tab(^P'Allow Feedback from Matrix',30);
  231.     write(':'^R); if configset.feedmatr then writeln('Yes') else writeln('No');
  232.     tab(^P'Allow Chat from Matrix',30);
  233.     write(':'^R); if configset.chatmatr then writeln('Yes') else writeln('No');
  234.     tab(^P'Leech Week active',30);
  235.     write(':'^R); if configset.leechwee then writeln('Yes') else writeln('No');
  236.     end;
  237. 12:begin
  238.    writestr(^P'Make leech week active ? *');
  239.    configset.leechwee:=yes;
  240.    if yes then writelog(21,11,'Yes') else writelog(21,11,'No');
  241.    end;
  242. end  until (q=13) or hungupon;
  243.    writestr(^M^P'Save the new configuration ? *');
  244.                       if not yes then exit;
  245.                       assign(fn,configset.forumdi+'CONFIG.BBS');
  246.                       rewrite(fn);
  247.                       write(fn,configset);
  248.                       close(fn);
  249.                       writeln(^M^P'New configuration saved!');
  250. end;
  251.  
  252.  
  253. procedure showsystemstatus;
  254. var totalused,totalidle,totalup,totaldown,totalmins,callsday:real;
  255.          cnt:integer;
  256.  
  257. var tp1:string[3];
  258. begin
  259.   totalused:=numminsused.total+elapsedtime(numminsused);
  260.   totalidle:=numminsidle.total;
  261.   totalup:=totalidle+numminsused.total;
  262.   totalmins:=1440.0*(numdaysup-1.0)+timer;
  263.   totaldown:=totalmins-totalup;
  264.   callsday:=round(10*numcallers/numdaysup)/10;
  265.   ClearScr;
  266.   mens:=true;
  267.   Nobreak:=false;
  268.   DontStop:=True;
  269.   AnsiColor(Urec.StatusBoxColor);
  270.   FuckXy(2,21,^P'[ ViSiON version '^A+VersionNum+^P' System Status ]');
  271.   AnsiColor(Urec.StatusBoxColor);
  272.  
  273.   BoxIt(4,1,40,8);
  274.   AnsiColor(Urec.STatusBoxColor);
  275.   FuckXy(4,3,^R'[ '^P'Main Status'^R' ]');
  276.   FuckXy(5,3,^R'Board Name...: '^S+ConfigSet.LongNam);
  277.   FuckXy(6,3,^R'SysOps Name..: '^S+RegisTo);
  278.   FuckXy(7,3,^R'Total Users..: '^S+Strr(NumUsers));
  279.   FuckXy(8,3,^R'Total Callers: '^S+StReal(NumCallers));
  280.   FuckXy(9,3,^R'Calls Today..: '^S+Strr(CallsToday));
  281.   FuckXy(10,3,^R'Calls per Day: '^S);
  282.   WriteLn(CallsDay:2:1);
  283.   AnsiColor(Urec.StatusBoxColor);
  284.  
  285.   BoxIt(4,42,30,6);
  286.   FuckXy(5,44,^R'Files Uploaded: '^S+StrLong(Gnuf)+^M);
  287.   FuckXy(6,44,^R'Total Messages: '^S+StrLong(Gnup)+^M);
  288.   FuckXy(7,44,^R'Final PCR.....: '^S+Strr(Ratio(Gnup,Trunc(NumCallers)))+^M);
  289.  
  290.   AnsiColor(Urec.StatusBoxColor);
  291.   BoxIt(10,42,30,7);
  292.   FuckXy(10,44,^R'[ '^P'Modem Status'^R' ]');
  293.   FuckXy(11,44,^R'Default Baud: '^S+Strlong(BaudRate));
  294.   FuckXy(12,44,^R'Comm Port...: '^S+Strr(ConfigSet.UseCo));
  295.   FuckXy(13,44,^R'Buffer Size.: '^S'512 bytes');
  296.   FuckXy(14,44,^R'Bytes Sent..: '^S+strr(totalsent));
  297.   FuckXy(15,44,^R'Bytes Recv..: '^S+strr(totalrece));
  298.   PrintXy(20,1,'');
  299. end;
  300.  
  301. procedure tabul (n:anystr; np:integer);
  302. var cnt:integer;
  303. begin
  304.   write (n);
  305.   ColorFB (1,0);
  306.   for cnt:=length(n) to np-1 do write ('.');
  307.   ColorFB (9,0);
  308. end;
  309.  
  310. procedure listusers;
  311. var cnt,u1,u2:integer;
  312.     u,uu : UserRec;
  313.     areacode:anystr;
  314. begin
  315.   writehdr ('Listing Users');
  316.   parserange (numusers,u1,u2);
  317.   if u1=0 then exit;
  318.   ClearScr; ANSiCOLOR(15);
  319.     writeln ('▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄');ANSiCOLOR(7);
  320.     write ('█'); ColorFB(1,7);
  321.     Write ('   Alias/User Handle          Main Level       User Note           Area Code ');
  322.     ANSiCOLOR(7); WriteLn('█'); ANSicolor(8);
  323.     writeln ('▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀');
  324.   if break then exit;
  325.   for cnt:=u1 to u2 do begin
  326.       ColorFB (9,0);
  327.     seek (ufile,cnt);
  328.     read (ufile,uu);
  329.     che;
  330.       if length(uu.handle)>0 then begin
  331.         if break then exit;
  332.         tabul (uu.handle,32);
  333.         if break then exit;
  334.         if uu.level>=100 then begin
  335.             ColorFB (12,0);
  336.             tabul ('SysOp',9);
  337.           ColorFB (9,0);
  338.         end else
  339.         if (uu.level>=90) and (uu.level<=99) then begin
  340.             ColorFB (4,0);
  341.           tabul ('CoSysOp',9);
  342.           ColorFB (9,0);
  343.         end else
  344.         if (uu.level<=1) then begin
  345.             ColorFB (4,0);
  346.             tabul ('NEW',9);
  347.           ColorFB (9,0);
  348.         end else
  349.         if (uu.level>ulvl) then begin
  350.           ColorFB (7,0);
  351.       tabul ('PRIV',9);
  352.           ColorFB (9,0);
  353.         end else begin
  354.         Colorfb(13,0);
  355.     tabul (strr(uu.level),9);
  356.         end;
  357.         if break then exit;
  358.         Colorfb(3,0);
  359.         tabul (uu.usernote,29);
  360.         if break then exit;
  361.         with uu do begin
  362.           Colorfb(14,0);
  363.           areacode:=uu.phonenum[1]+uu.phonenum[2]+uu.phonenum[3];
  364.           tabul ('['+areacode+']',5);
  365.             ColorFB (9,0);
  366.         end;
  367.         if break then exit;
  368.        writeln;
  369.       end
  370.     end;
  371. end;
  372.  
  373. procedure transfername;
  374. var un,nlvl,ntime,tmp:integer;
  375.     u:userrec;
  376. begin
  377.   if ulvl<configset.sysopleve then writeln(^M'You can''t do this without SysOp Access!');
  378.   if ulvl>configset.sysopleve-1 then begin
  379.   if tempsysop then begin
  380.     writestr ('Disabling temporary sysop powers...');
  381.     ulvl:=regularlevel;
  382.     tempsysop:=false
  383.   end;
  384.   writestr ('Transfer to user name:');
  385.   if length(input)=0 then exit;
  386.   un:=lookupuser(input);
  387.   if unum=un then begin
  388.     writestr ('You can''t transfer to yourself!');
  389.     exit
  390.   end;
  391.   if un=0 then begin
  392.     writestr ('No such user.');
  393.     exit
  394.   end;
  395.   seek (ufile,un);
  396.   read (ufile,u);
  397.   if ulvl<configset.sysopleve then if not checkpassword(u) then begin
  398.     writelog (1,5,u.handle);
  399.     exit
  400.   end;
  401.   writelog (1,4,u.handle);
  402.   updateuserstats (false);
  403.   ntime:=0;
  404.   if datepart(u.laston)<>datepart(now) then begin
  405.     tmp:=ulvl;
  406.     if tmp<1 then tmp:=1;
  407.     if tmp>100 then tmp:=100;
  408.     ntime:=configset.usertim[tmp]
  409.   end;
  410.   if u.timetoday<10
  411.     then if issysop or (u.level>=configset.sysopleve)
  412.       then
  413.         begin
  414.           writestr ('The user has '+strr(u.timetoday)+' min(s) left!');
  415.           writestr ('New time left:');
  416.           ntime:=valu(input)
  417.         end
  418.       else
  419.         if u.timetoday>0
  420.           then writeln ('Warning: You have ',u.timetoday,' minutes left!')
  421.           else
  422.             begin
  423.               writestr ('Sorry, that user doesn''t have any time left!');
  424.               exit
  425.             end;
  426.   unum:=un;
  427.   readurec;
  428.   if ntime<>0 then begin
  429.     urec.timetoday:=ntime;
  430.     writeurec
  431.   end;
  432.  end;
  433. end;
  434.  
  435. Procedure editnews;
  436.   Var nn,numnews:Integer;
  437.     nf:File Of newsrec;
  438.     News:newsrec;
  439.   Procedure getnn(txt:mstr);
  440.     Begin
  441.       writestr(^S+'News number to '+^R+txt+^S+':');
  442.       nn:=valu(Input);
  443.       If (nn<1) Or (nn>numnews) Then nn:=0
  444.     End;
  445.  
  446.   Procedure delnews;
  447.     Var cnt:Integer;
  448.       r:Integer;
  449.       NTmp:newsrec;
  450.     Begin
  451.       If nn=0 Then getnn('delete');
  452.       If nn<>0 Then Begin
  453.         Seek(nf,nn-1);
  454.         Read(nf,Ntmp);che;
  455.         deletetext(Ntmp.Location);
  456.         numnews:=FileSize(nf)-1;
  457.         For cnt:=nn To numnews Do
  458.           Begin
  459.             Seek(nf,cnt);
  460.             Read(nf,nTmp);
  461.             Seek(nf,cnt-1);
  462.             Write(nf,Ntmp)
  463.           End;
  464.         Seek(nf,numnews);
  465.         Truncate(nf)
  466.       End
  467.     End;
  468.  
  469.   Procedure listnews;
  470.     Var cnt:Integer;
  471.       r,sector:Integer;
  472.       q:buffer;
  473.       l:anystr;
  474.       k:Char;
  475.       Ntmp:newsrec;
  476.     Begin
  477.       clearbreak;
  478.       WriteLn (^S'  News    Min    Max          Title ' ) ;
  479.       WriteLn (^S' Number  Level  Level' ) ;
  480.       WriteLn ;
  481.  
  482.       For cnt:=1 To numnews Do Begin
  483.         Seek(nf,cnt-1);
  484.         Read(nf,ntmp);
  485.         r:=ntmp.location;
  486.         Seek(tfile,r);
  487.         Read(tfile,q);
  488.  
  489.         Write( Cnt:5 , '    ' , ntmp.level:5,'  ',ntmp.maxlevel:5, ' ');
  490.         r:=1;
  491.         k:=' ';
  492.         l:='';
  493.         Writeln (ntmp.title);
  494.         If break Then exit
  495.       End;
  496.     End;
  497.  
  498.   Procedure viewnews;
  499.     Var r:Integer;
  500.       Ntmp:newsrec;
  501.     Begin
  502.       If nn=0 Then getnn('view');
  503.       If nn<>0 Then Begin
  504.         Seek(nf,nn-1);
  505.         Read(nf,nTmp);che;
  506.         r:=ntmp.location;
  507.         WriteLn('News #',nn,' ''',ntmp.title,''' From :',ntmp.from);
  508.         WriteLn('Date: ',Datestr(ntmp.when),' Level [',ntmp.level,'-',ntmp.maxlevel,']');
  509.         WriteLn('__________________________');
  510.         printtext(r);
  511.         writestr(^P^M'Press [Return] to continue.*')
  512.       End
  513.     End;
  514.  
  515.  
  516.   Procedure adddnews;
  517.     Begin
  518.       Close(nf);
  519.       addnews;
  520.       Assign(nf,'News');
  521.       Reset(nf)
  522.     End;
  523.  
  524.   Var q:Integer;
  525.   Begin
  526.     Assign(nf,'News');
  527.     Reset(nf);
  528.     If IOResult<>0 Then writestr('No news!  Use [A] to add some!') Else Begin
  529.       Repeat
  530.         numnews:=FileSize(nf);
  531.         Write(^B^M'News entries: ',numnews);
  532.         q:=menu('News edit','NEWS','ADLVQE');
  533.         nn:=valu(Copy(Input,2,255));
  534.         If (nn<1) Or (nn>numnews) Then nn:=0;
  535.         Case q Of
  536.           1:adddnews;
  537.           2:delnews;
  538.           3:listnews;
  539.           4:viewnews;
  540.         End;
  541.         If numnews=0 Then Begin
  542.           Close(nf);
  543.           Erase(nf);
  544.           q:=5
  545.         End
  546.       Until (q=5) Or hungupon
  547.     End;
  548.     Close(nf)
  549.   End;
  550.  
  551.  
  552.  
  553. procedure delerrlog;
  554. var e:text;
  555.     i:integer;
  556. begin
  557.   writestr ('Delete error log:  Confirm:');
  558.   if not yes then exit;
  559.   assign (e,'errlog');
  560.   reset (e);
  561.   i:=ioresult;
  562.   if ioresult=1
  563.     then writeln (^M'No error log!')
  564.     else begin
  565.       textclose (e);
  566.       erase (e);
  567.       writestr ('Error log deleted.');
  568.       if ioresult>1
  569.         then writeln ('I/O error ',i,' deleting error log!');
  570.       writelog (2,2,'')
  571.     end
  572. end;
  573.  
  574. procedure feedback;
  575. var m:mailrec;
  576.     me:message;
  577. begin
  578.   writestr (^P'Leave '^R+configset.Sysopnam+^P' feedback? *');
  579.   if not yes then exit;
  580.   m.line:=editor(me,false,true,'0','0');
  581.   if m.line<0 then exit;
  582.   m.title:=me.title;
  583.   m.sentby:=unam;
  584.   m.anon:=false;
  585.   m.when:=now;
  586.   addfeedback (m);
  587.   writestr ('Feedback sent.')
  588. end;
  589.  
  590. procedure settime;
  591. var t:integer;
  592.     n:longint;
  593.     r:registers;
  594.     d:datetime;
  595.     ken:integer;
  596. begin
  597. ken:=timeleft;
  598.   writestr ('Current time: '+timestr(now));
  599.   writestr ('Current date: '+datestr(now));
  600.   writestr ('Enter new time:');
  601.   if length(input)<>0
  602.     then begin
  603.       t:=timeleft;
  604.       unpacktime (timeval(input),d);
  605.       r.ch:=d.hour;
  606.       r.cl:=d.min;
  607.       r.dh:=0;
  608.       r.dl:=0;
  609.       r.ah:=$2d;
  610.       intr ($21,r);
  611.       if r.al=$ff then writestr ('Invalid time!');
  612.       settimeleft (t)
  613.     end;
  614.   writestr ('Enter new date:');
  615.   if length(input)<>0
  616.     then begin
  617.       unpacktime (dateval(input),d);
  618.       r.dl:=d.day;
  619.       r.dh:=d.month;
  620.       r.cx:=d.year;
  621.       r.ah:=$2b;
  622.       intr ($21,r);
  623.       if r.al=$ff then writestr ('Invalid date!')
  624.     end;
  625.     settimeleft(ken);
  626.   writelog (2,4,'')
  627. end;
  628.  
  629. procedure changepwd;
  630. var t:sstr;
  631. begin
  632.   writehdr ('Password Change');
  633.   dots:=true;
  634.   buflen:=15;
  635.   write ('Enter new password: ');
  636.   if getpassword
  637.     then begin
  638.       writeurec;
  639.       writestr ('Password changed.');
  640.       writelog (1,1,'')
  641.     end else
  642.       writestr ('No change.')
  643. end;
  644.  
  645. procedure requestraise;
  646. var t:text;
  647.     q:lstr;
  648.     p,l1,l2:integer;
  649.     s1,s2:sstr;
  650.     me:message;
  651.     m:mailrec;
  652. label nope,found;
  653. begin
  654.   assign (t,configset.textfiledi+'RAISEREQ');
  655.   reset (t);
  656.   if ioresult<>0 then goto nope;
  657.   printtexttopoint (t);
  658.   while not eof(t) do begin
  659.     readln (t,q);
  660.     p:=pos('-',q);
  661.     if p>0
  662.       then
  663.         begin
  664.           s1:=copy(q,1,p-1);
  665.           s2:=copy(q,p+1,255)
  666.         end
  667.       else
  668.         begin
  669.           s1:=copy(q,1,15);
  670.           s2:=s1
  671.         end;
  672.     val (s1,l1,p);
  673.     if p=0 then val (s2,l2,p);
  674.     if p<>0 then begin
  675.       textclose (t);
  676.       error ('Invalid range in RAISEREQ: %1','',q);
  677.       exit
  678.     end;
  679.     if (ulvl>=l1) and (ulvl<=l2) then goto found;
  680.     skiptopoint (t)
  681.   end;
  682.   nope:
  683.   error ('No text for level %1','',strr(ulvl));
  684.   textclose (t);
  685.   p:=ioresult;
  686.   exit;
  687.   found:
  688.   printtexttopoint (t);
  689.   textclose (t);
  690.   if hungupon then exit;
  691.   m.line:=editor (me,false,true,'0','0');
  692.   if m.line<0 then exit;
  693.   m.anon:=false;
  694.   m.title:='Raise request; now lvl='+strr(ulvl);
  695.   m.sentby:=unam;
  696.   m.when:=now;
  697.   addfeedback (m);
  698. end;
  699.  
  700. procedure leechlist;
  701. var u:userrec;
  702.     f,l:integer;
  703.     x1,x2,x3,ud,udk:longint;
  704.     y1,y2,y3:real;
  705.     worsud,worsudk:longint;
  706.     w1,w2:mstr;
  707.     beenaborted:boolean;
  708. begin
  709. f:=1;
  710. l:=numusers;
  711. seek(ufile,f);
  712. clearscr;
  713. beenaborted:=false;
  714. writehdr(' Leech List ');
  715. writeln(^R'Name');
  716. writeln(^U'────────────────────────────');
  717. w1:='Yer Momma';
  718. w2:=w1;
  719. worsud:=10000;
  720. worsudk:=10000;
  721. write(^B);
  722. for f:=1 to l do begin
  723. read(ufile,u);
  724. if break then beenaborted:=true;
  725. x1:=u.uploads;
  726. x2:=u.downloads;
  727. if x1<1 then x1:=1;
  728. if x2<1 then x2:=1;
  729. y1:=int(x1);
  730. y2:=int(x2);
  731. y3:=y1/y2;
  732. y3:=y3*100;
  733. x3:=trunc(y3);
  734. ud:=x3;
  735. x1:=u.upkay;
  736. x2:=u.dnkay;
  737. if x1<1 then x1:=1;
  738. if x2<1 then x2:=1;
  739. y1:=int(x1);
  740. y2:=int(x2);
  741. y3:=y1/y2;
  742. y3:=y3*100;
  743. x3:=trunc(y3);
  744. udk:=x3;
  745. if not beenaborted then
  746. if ((configset.leechud>=ud) or (configset.leechk>=udk)) and (u.level<configset.exemptpc) then begin
  747. write(^B);
  748. writeln(u.handle);
  749. if udk<worsudk then begin
  750. worsudk:=udk;
  751. w1:=u.handle;
  752. end;
  753. if ud<worsud then begin
  754. worsud:=ud;
  755. w2:=u.handle;
  756. end;
  757. end;
  758. end;
  759. writeln(^M^P'The worst offenders are:');
  760. writeln(^R'For U/D Ratio it goes to ',w2,' with a ',worsud,'% ratio!');
  761. writeln(^R'For U/D K it goes to ',w1,' with a ',worsudk,'% ratio!');
  762. writeln(^M^P'If your handle is above here, you should do something to clear it up!');
  763. end;
  764.  
  765.  
  766. procedure timebanks;
  767. var tm,tm2,tm3,tmp:integer;
  768.     ke:string[1];
  769. begin
  770. if not configset.usetimebank then begin
  771. clearscr;
  772. writeln(^R'Sorry, but the Time Bank is closed right now!');
  773. exit;
  774. end;
  775. if urec.level<configset.levelusetb then begin
  776. clearscr;
  777. writeln(^R'Sorry, you do not have enough access to use the time-bank!');
  778. exit;
  779. end;
  780. repeat
  781. clearscr;
  782. writehdr(' The Time Bank ');
  783. writeln(^M^R'You have ',timeleft,' min(s) left online today.');
  784. writeln(^M^R'You have ',urec.timebank,' min(s) in your bank account.');
  785. writestr(^M^P'[W]ithdraw, [D]eposit, [Q]uit :*');
  786. ke:=upstring(input);
  787. if match(ke,'D') then begin
  788.   if (urec.timebank>=configset.totalallowed) then
  789.   writeln('I''m sorry, but you already have the maximum allowed in your account!')
  790.   else begin
  791.   tm:=configset.totalallowed-urec.timebank;
  792.   if tm>timeleft then tm:=timeleft;
  793.   writestr(^P'You may deposit up to '+strr(tm)+' minutes. How much do you wish to deposit? *');
  794.   tm2:=valu(input);
  795.   if tm2<0 then writeln('That was invalid!') else
  796.   if tm2>tm then writeln('Sorry, you have broken the maximum limit!') else
  797.   if tm2>timeleft then writeln('Sorry, you don''t have that much time left!')
  798.   else begin
  799.      urec.timebank:=urec.timebank+tm2;
  800.      settimeleft(timeleft-tm2);
  801.      writeln(Tm2,' minutes have been deposited in your account!');
  802.   end;
  803.  end;
  804.  end;
  805.  if match(input,'W') then begin
  806.   if urec.timebank<1 then writeln('I''m sorry, but you have no time in your account to withdraw!')
  807.   else begin
  808.     writestr(^M'You may withdraw up to '+strr(urec.timebank)+' minutes. How much to withdraw?*');
  809.     tm:=valu(input);
  810.     if tm<0 then writeln('Invalid choice!') else
  811.     if tm>urec.timebank then writeln('Yes, that would be nice, but you don''t have that kind of time!')
  812.     else  begin
  813.     urec.timebank:=urec.timebank-tm;
  814.     settimeleft(timeleft+tm);
  815.     writeln(^M,tm,' minutes have been withdrawn from your account!');
  816.     end;
  817.   end;
  818.   end;
  819.   delay(500);
  820. until match(ke,'Q') or hungupon;
  821. end;
  822.  
  823.  
  824.  
  825.  
  826. procedure rumormenu;
  827. var rfile:file of rumorrec;
  828.     r,ar:rumorrec;
  829.  
  830.   function numrumors:integer;
  831.   begin
  832.     numrumors:=filesize(rfile)
  833.   end;
  834.  
  835.   procedure seekrfile (n:integer);
  836.   begin
  837.     seek (rfile,n-1)
  838.   end;
  839.  
  840.   procedure openrfile;
  841.   var n:integer;
  842.   begin
  843.     n:=ioresult;
  844.     assign (rfile,'Rumors.Dat');
  845.     reset (rfile);
  846.     if ioresult<>0 then begin
  847.       close (rfile);
  848.       n:=ioresult;
  849.       rewrite (rfile)
  850.     end
  851.   end;
  852.  
  853. procedure showit (n:integer);
  854. var rr:rumorrec;
  855.     x:integer;
  856.     p:byte;
  857.     a,sex,horndogz,fuck:string;
  858. begin
  859.    seekrfile (n);
  860.    read (rfile,rr);
  861.    if ulvl<rr.level then exit;
  862.    writeln;
  863.    x:=1;
  864.   while x <= length(rr.rumor) do begin
  865.   case rr.rumor[x] of
  866.     '|':begin
  867.     x:=x + 1;
  868.     sex:=copy(rr.rumor,x,1);
  869.     horndogz:=copy(rr.rumor,x+1,1);
  870.     a:=(upcase(sex[1]))+(upcase(horndogz[1]));
  871.     if x <= length(rr.rumor) then begin
  872.     If
  873.     a='01' then ansicolor(1) else If
  874.     a='02' then ansicolor(2) else if
  875.     a='03' then ansicolor(3) else if
  876.     a='04' then ansicolor(4) else if
  877.     a='05' then ansicolor(5) else if
  878.     a='06' then ansicolor(6) else if
  879.     a='07' then ansicolor(7) else if
  880.     a='08' then ansicolor(8) else if
  881.     a='09' then ansicolor(9) else if
  882.     a='10' then ansicolor(10) else if
  883.     a='11' then ansicolor(11) else if
  884.     a='12' then ansicolor(12) else if
  885.     a='13' then ansicolor(13) else if
  886.     a='14' then ansicolor(14) else if
  887.     a='15' then ansicolor(15);
  888.     end;
  889.     x:=x + 2;
  890.     end else begin
  891.     write (rr.rumor[x]);
  892.     x:=x + 1;
  893.     end
  894.   end;
  895. end;
  896. ansireset;
  897. If urec.prompttype=1 then WriteLn(^M^M);
  898. If urec.prompttype=2 then WriteLn(^M^M);
  899. end;
  900.  
  901.   procedure listrumors;
  902.   var cnt:integer;
  903.       b:boolean;
  904.       t,n1,n2:integer;
  905.   begin
  906.     writeln;
  907.     ansireset;
  908.     if numrumors<1 then begin
  909.      writeln ('There are no Rumors!');
  910.      exit;
  911.     end;
  912.     b:=true;
  913.     seekrfile (1);
  914.     writehdr ('Rumors List');
  915.     parserange (numrumors,n1,n2);
  916.     if n1=0 then exit;
  917.     t:=n1-1;
  918.     for cnt:=n1 to n2 do begin
  919.         t:=t+1;
  920.         seek (rfile,t-1);
  921.         read (rfile,r);
  922.         if b then begin
  923.          writeln
  924.          (^P'#'^S'   Title                         '^U'Date      '^R'Author');
  925.          writeln(^S'────────────────────────────────────────────────────────────────────────'^M^R);
  926.          b:=false
  927.         end;
  928.         ansicolor (urec.promptcolor);
  929.         tab (strr(cnt),4);
  930.         ansicolor (urec.statcolor);
  931.         tab (r.title,30);
  932.         ansicolor (urec.inputcolor);
  933.         tab (datestr(r.when),10);
  934.         ansicolor (urec.regularcolor);
  935.         if r.author='...!@ANON#$...' then
  936.         begin
  937.          write ('[Anonymous]');
  938.          if ulvl>=configset.anonymousleve then write (^R,' ('^S,r.author2,^R')');
  939.          writeln;
  940.         end
  941.         else writeln (^S,r.author);
  942.         ansireset;
  943.         if break then exit;
  944.         ansicolor (urec.regularcolor);
  945.     end;
  946.     if b then writestr ('There are no Rumors!')
  947.   end;
  948.  
  949.   function getrnum (txt:mstr):integer;
  950.   var n:integer;
  951.   begin
  952.     getrnum:=0;
  953.     repeat
  954.       writeln;
  955.       writestr ('Rumor Number to '+txt+' [?/List]:');
  956.       if length(input)=0 then exit;
  957.       if upcase(input[1])='?'
  958.         then listrumors
  959.         else begin
  960.           n:=valu(input);
  961.           if (n<1) or (n>numrumors) then begin
  962.             writestr (^M'Number out of range!');
  963.             exit
  964.           end;
  965.           seekrfile (n);
  966.           read (rfile,r);
  967.           if (ulvl<r.level) and (not issysop) then exit;
  968.           getrnum:=n;
  969.           exit
  970.         end
  971.     until hungupon
  972.   end;
  973.  
  974. procedure showrumor (n:integer);
  975. var rr:rumorrec;
  976. begin
  977.    seekrfile (n);
  978.    read (rfile,rr);
  979.    if ulvl<rr.level then exit;
  980.    writeln;
  981.    showit(n);
  982.    ansireset;
  983. end;
  984.  
  985.   procedure addrumor;
  986.   var x,b:boolean;
  987.       y,t:text;
  988.       cdir,cddir:lstr;
  989.       n:integer;
  990.       z:anystr;
  991.       apecks:rumorrec;
  992.  
  993.   function matchtitle (f:sstr):integer;
  994.   var cnt:integer;
  995.       monark:rumorrec;
  996.   begin
  997.     for cnt:=1 to numrumors do begin
  998.       seekrfile (cnt);
  999.       read (rfile,monark);
  1000.       if match (monark.title,f) then begin
  1001.         matchtitle:=cnt;
  1002.         ansireset;
  1003.         exit
  1004.       end
  1005.     end;
  1006.     matchtitle:=0
  1007.   end;
  1008.  
  1009.     begin
  1010.     if ulvl<2 then begin
  1011.      reqlevel (2);
  1012.      exit
  1013.     end;
  1014.     if numrumors>=999 then begin
  1015.      writeln;
  1016.      writeln ('Sorry, there are too many rumors now!');
  1017.      writeln ('Ask your Sysop to delete some.');
  1018.      exit
  1019.     end;
  1020.     ansireset;
  1021.   writehdr('Add a Rumor');
  1022.     buflen:=30;
  1023.     writeln (^U'      '^S'─────────────────────────────-'^U'');
  1024.     writestr('Title: &');
  1025.     apecks.title:=input;
  1026.     if length(input)=0 then exit;
  1027.     if matchtitle(apecks.title)>0 then begin
  1028.      writeln;
  1029.      writeln ('Sorry, that Rumor already exists! Try another Title!');
  1030.      exit
  1031.     end;
  1032.     apecks.level:=1;
  1033.     apecks.author:=unam;
  1034.     apecks.author2:=unam;
  1035.     writeln;
  1036.     if ulvl>=configset.anonymousleve then begin
  1037.      writestr ('Post Rumor Anonymous [y/n]? *');
  1038.      if yes then apecks.author:='...!@ANON#$...' else
  1039.      apecks.author:=unam;
  1040.     end;
  1041.     apecks.when:=now;
  1042.     ansireset;
  1043.     writeln;
  1044.     writestr ('Level required to read Rumor [CR/1]: *');
  1045.     if length(input)=0 then apecks.level:=1 else
  1046.     apecks.level:=valu(input);
  1047.     writeln;
  1048.     writeln ('Enter Rumor [CR to Abort] Use |01 - |15 For Color');
  1049.     buflen:=78;
  1050.     writeln (^U' '^S'──────────────────────────────────────────────────────────────────────────-'^U'');
  1051.     writestr('> &');
  1052.     if input='' then exit;
  1053.     b:=true;
  1054.     apecks.rumor:=input;
  1055.     seekrfile (numrumors+1);
  1056.     write (rfile,apecks);
  1057.     if b then writeln (^M'Rumor created!');
  1058.     if not b then begin
  1059.     exit
  1060.     end;
  1061.   end;
  1062.  
  1063.   procedure deleterumor;
  1064.   var cnt,n:integer;
  1065.       f:file;
  1066.   begin
  1067.     n:=getrnum ('Delete');
  1068.     if n=0 then exit;
  1069.     seekrfile (n);
  1070.     read (rfile,r);
  1071.     if not issysop then
  1072.     if not match(r.author2,unam) then
  1073.     begin
  1074.      writeln;
  1075.      writeln ('You didn''t post that!!');
  1076.      writeln;
  1077.      exit
  1078.     end;
  1079.     writeln;
  1080.     seekrfile(n);
  1081.     showit(n);
  1082.     writeln;
  1083.     writestr ('Delete this Rumor [y/n]? *');
  1084.     if not yes then exit;
  1085.     for cnt:=n+1 to numrumors do begin
  1086.      seekrfile (cnt);
  1087.      read (rfile,r);
  1088.      seekrfile (cnt-1);
  1089.      write (rfile,r);
  1090.     end;
  1091.     seekrfile (numrumors);
  1092.     truncate (rfile);
  1093.     writelog (1,8,r.title)
  1094.   end;
  1095.  
  1096.   const beenaborted:boolean=false;
  1097.  
  1098.   function aborted:boolean;
  1099.   begin
  1100.     if beenaborted then begin
  1101.       aborted:=true;
  1102.       exit
  1103.     end;
  1104.     aborted:=xpressed or hungupon;
  1105.     if xpressed then begin
  1106.       beenaborted:=true;
  1107.       writeln (^B'Newscan aborted!')
  1108.     end
  1109.   end;
  1110.  
  1111.   procedure rumorsnewscan;
  1112.   var first,cnt:integer;
  1113.       nd:boolean;
  1114.       re:rumorrec;
  1115.   begin
  1116.     writehdr ('Rumors Newscan');
  1117.     if numrumors<1 then exit;
  1118.     for cnt:=1 to numrumors do begin
  1119.      seekrfile (cnt);
  1120.      read (rfile,re);
  1121.      if (re.when>laston) and (ulvl>=re.level) then begin
  1122.       ansicolor (urec.inputcolor);
  1123.       tab (strr(cnt)+'.',4);
  1124.       ansicolor (urec.promptcolor);
  1125.       write  (re.title);
  1126.       ansicolor (urec.regularcolor);
  1127.       write (' by ');
  1128.       ansicolor (urec.inputcolor);
  1129.       if re.author='...!@ANON#$...' then
  1130.       write ('<Anonymous>') else write (re.author2);
  1131.       writeln;
  1132.       showit(cnt)
  1133.      end;
  1134.     end;
  1135.   end;
  1136.  
  1137.   procedure searchfortext;
  1138.   var x:integer;
  1139.       mixmasterfag:boolean;
  1140.       s:anystr;
  1141.       rr:rumorrec;
  1142.   begin
  1143.    if numrumors<1 then begin
  1144.     writeln (^M'No Rumors Exist!'^M);
  1145.     exit;
  1146.    end;
  1147.    writehdr ('Search for Text in all Rumors');
  1148.    writeln ('Enter Text to search for:');
  1149.    writestr ('-> &');
  1150.    writeln;
  1151.    if length(input)=0 then exit;
  1152.    s:=input;
  1153.    s:=upstring(s);
  1154.    for x:=1 to numrumors do begin
  1155.     mixmasterfag:=false;
  1156.     seekrfile (x);
  1157.     read (rfile,rr);
  1158.     if pos(s,upstring(rr.title))>0 then mixmasterfag:=true;
  1159.     if pos(s,upstring(rr.rumor))>0 then mixmasterfag:=true;
  1160.     if pos(s,upstring(rr.author))>0 then mixmasterfag:=true;
  1161.     if ((ulvl>=configset.anonymousleve) and (pos(s,upstring(rr.author2))>0)) then mixmasterfag:=true;
  1162.     if (mixmasterfag=true) and (ulvl>=rr.level) then begin
  1163.      ansicolor (urec.inputcolor);
  1164.      tab (strr(x)+'.',4);
  1165.      ansicolor (urec.promptcolor);
  1166.      write  (rr.title);
  1167.      ansicolor (urec.regularcolor);
  1168.      write (' by ');
  1169.      ansicolor (urec.inputcolor);
  1170.      if rr.author='...!@ANON#$...' then
  1171.      write ('<Anonymous>') else write (rr.author2);
  1172.      writeln;
  1173.      write (' "');
  1174.      ansicolor (urec.statcolor);
  1175.      write (rr.rumor);
  1176.      ansicolor (urec.regularcolor);
  1177.      writeln ('"');
  1178.     end;
  1179.    end;
  1180.   end;
  1181.  
  1182. label later;
  1183. var prompt:lstr;
  1184.     n,q,b:integer;
  1185.     k:char;
  1186.     mp:boolean;
  1187. begin
  1188.   if not configset.userume then begin
  1189.    writeln;
  1190.    writeln ('Rumors are not in use!');
  1191.    writeln;
  1192.    exit;
  1193.   end;
  1194.   openrfile;
  1195.   mp:=moreprompts in urec.config;
  1196.   if mp then urec.config:=urec.config-[moreprompts];
  1197.   repeat
  1198.     q:=menu ('Rumors','RUMOR','LAD#EQNS');
  1199.     writeln;
  1200.     if q<0 then begin
  1201.      b:=-q;
  1202.      if (b<0) or (b>numrumors) then
  1203.      writeln (^M'Number out of range!') else
  1204.      showrumor (b);
  1205.     end else
  1206.     case q of
  1207.      1:listrumors;
  1208.      2:addrumor;
  1209.      3:deleterumor;
  1210.      7:rumorsnewscan;
  1211.      8:searchfortext;
  1212.     end;
  1213.   until (q=6) or (hungupon);
  1214.   later:
  1215.   close (rfile);
  1216.   if mp then urec.config:=urec.config+[moreprompts];
  1217. end;
  1218.  
  1219. procedure randomrumor;
  1220. var rfile:file of rumorrec;
  1221.  
  1222.   function numrumors:integer;
  1223.   begin
  1224.     numrumors:=filesize(rfile)
  1225.   end;
  1226.  
  1227.   procedure seekrfile (n:integer);
  1228.   begin
  1229.     seek (rfile,n-1)
  1230.   end;
  1231.  
  1232.   procedure openrfile;
  1233.   var n:integer;
  1234.   begin
  1235.     n:=ioresult;
  1236.     assign (rfile,'Rumors.Dat');
  1237.     reset (rfile);
  1238.     if ioresult<>0 then begin
  1239.       close (rfile);
  1240.       n:=ioresult;
  1241.       rewrite (rfile)
  1242.     end
  1243.   end;
  1244.  
  1245. procedure showit (n:integer);
  1246. var rr:rumorrec;
  1247.     x:integer;
  1248.     p:byte;
  1249.     a,sex,horndogz,fuck:string;
  1250. begin
  1251.    seekrfile (n);
  1252.    read (rfile,rr);
  1253.    if ulvl<rr.level then exit;
  1254.    writeln;
  1255.    x:=1;
  1256.   while x <= length(rr.rumor) do begin
  1257.   case rr.rumor[x] of
  1258.     '|':begin
  1259.     x:=x + 1;
  1260.     sex:=copy(rr.rumor,x,1);
  1261.     horndogz:=copy(rr.rumor,x+1,1);
  1262.     a:=(upcase(sex[1]))+(upcase(horndogz[1]));
  1263.     if x <= length(rr.rumor) then begin
  1264.     If
  1265.     a='01' then ansicolor(1) else If
  1266.     a='02' then ansicolor(2) else if
  1267.     a='03' then ansicolor(3) else if
  1268.     a='04' then ansicolor(4) else if
  1269.     a='05' then ansicolor(5) else if
  1270.     a='06' then ansicolor(6) else if
  1271.     a='07' then ansicolor(7) else if
  1272.     a='08' then ansicolor(8) else if
  1273.     a='09' then ansicolor(9) else if
  1274.     a='10' then ansicolor(10) else if
  1275.     a='11' then ansicolor(11) else if
  1276.     a='12' then ansicolor(12) else if
  1277.     a='13' then ansicolor(13) else if
  1278.     a='14' then ansicolor(14) else if
  1279.     a='15' then ansicolor(15);
  1280.     end;
  1281.     x:=x + 2;
  1282.     end else begin
  1283.     write (rr.rumor[x]);
  1284.     x:=x + 1;
  1285.     end
  1286.   end;
  1287. end;
  1288. ansireset;
  1289. If urec.prompttype=1 then WriteLn(^M^M);
  1290. If urec.prompttype=2 then WriteLn(^M^M);
  1291. end;
  1292.  
  1293. var x:integer;
  1294. begin
  1295.  if not configset.userume then exit;
  1296.  openrfile;
  1297.  if numrumors<1 then begin
  1298.   writeln;
  1299.   ansicolor (11);
  1300.   write ('"');
  1301.   ansicolor (12);
  1302.   write ('Press ''R'' to make a Rumor...');
  1303.   ansicolor (11);
  1304.   writeln ('"');
  1305.   ansireset;
  1306.  end else
  1307.  begin
  1308.   seekrfile (1);
  1309.   randomize;
  1310.   x:=random (numrumors+1);
  1311.   showit (x);
  1312.  end;
  1313.  close (rfile);
  1314.  ansireset;
  1315. end;
  1316.  
  1317.  
  1318. procedure loozerlists;
  1319. var fn:text;
  1320.     Num:Integer;
  1321.     Loozers:Array[1..500] of Mstr;
  1322.     dummystr:mstr;
  1323.     Ch:Char;
  1324.  
  1325.   Procedure ShowLoozers;
  1326.   Var Cnt:Integer;
  1327.   Begin
  1328.   ClearScr;
  1329.   WriteHdr('Loozer Lists');
  1330.   For Cnt:=1 to Num Do
  1331.     WriteLn(^S'[',Cnt,'] '^R+Loozers[Cnt]);
  1332.   End;
  1333.  
  1334.   Procedure AddLoozers;
  1335.   Begin
  1336.     WriteStr(^M^R'Enter name of Loozer to Add:');
  1337.     if Input<>'' then Begin
  1338.       Inc(Num);
  1339.       Loozers[Num]:=Input;
  1340.     End;
  1341.   End;
  1342.  
  1343.   Procedure DeleteLoozer;
  1344.   Var Cnt:Integer;
  1345.   Begin
  1346.     WriteStr(^M^R'Enter the # of the Loozer to Delete:');
  1347.     If (Input='') or (valu(Input)<1) or (Valu(Input)>Num) then Exit;
  1348.     If Valu(Input)=Num then  Else
  1349.       For Cnt:=Valu(Input) to Num-1 do Loozers[Cnt]:=Loozers[Cnt+1];
  1350.       Dec(Num);
  1351.     End;
  1352.  
  1353.   Procedure SaveLoozers;
  1354.   Var Cnt:Integer;
  1355.   Begin
  1356.    Assign(Fn,ConfigSet.TextFileDi+'BlackLst');
  1357.    ReWrite(Fn);
  1358.    For Cnt:=1 to Num Do WriteLn(Fn,Loozers[Cnt]);
  1359.    TextClose(Fn);
  1360.    End;
  1361.  
  1362.   Procedure ReadLoozers;
  1363.   Begin
  1364.     Assign(Fn,ConfigSet.TextFileDi+'BlackLst');
  1365.     Reset(Fn);
  1366.     Num:=0;
  1367.     While Not Eof(Fn) do
  1368.       Begin
  1369.         ReadLn(Fn,DummyStr);
  1370.         Inc(Num);
  1371.         Loozers[Num]:=DummyStr;
  1372.       End;
  1373.     TextClose(Fn);
  1374.    End;
  1375.  
  1376. begin
  1377. if not exist(configset.textfiledi+'Blacklst') then begin
  1378. writestr(^M+'There is no loozer list, do you wish to create one now? *');
  1379. if not yes then exit;
  1380. assign(fn,configset.textfiledi+'Blacklst');
  1381. rewrite(fn);
  1382. textclose(fn);
  1383. end;
  1384.   ReadLoozers;
  1385.   Repeat
  1386.     ShowLoozers;
  1387.     WriteStr(^M^R'[A]dd a loozer, [D]elete a Loozer, [Q]uit:');
  1388.     If Input='' then Input:='L';
  1389.     Ch:=UpCase(Input[1]);
  1390.       If Ch='A' then AddLoozers;
  1391.       If Ch='D' then DeleteLoozer;
  1392.   Until (Ch='Q') or HungUpOn;
  1393.   saveloozers;
  1394. end;
  1395.  
  1396. procedure nodelists;
  1397. Var Node:NodeNetRec;
  1398.     FN:File of NodeNetRec;
  1399.     I,J,CNT:Integer;
  1400.     C:Char;
  1401.  
  1402.     Procedure ShowNode;
  1403.     Begin
  1404.       ClearScr;
  1405.       WriteLn(^R'Node #'^S,I);
  1406.       Tab(^R+'Node Password',30);
  1407.       WriteLn(':'^S,Node.Pass);
  1408.       Tab(^R+'Node Name',30);
  1409.       WriteLn(':'^S,Node.Name);
  1410.       Tab(^R+'Node Phone Number',30);
  1411.       WriteLn(':'^S,Node.Phone);
  1412.       Tab(^R+'Node Baud Rate',30);
  1413.       WriteLn(':'^S,Node.Baud);
  1414.       Tab(^R+'Node ID Number',30);
  1415.       WriteLn(':'^S,Node.Node);
  1416.       WriteStr(^M^P'Press '^R'[Return]'^P' to see networked Bases:');
  1417.       ClearScr;
  1418.       Cnt:=1;
  1419.       Repeat
  1420.           If Node.BaseSelection[Cnt] then WriteLn('Base ID #',Cnt,' is networked!');
  1421.           Inc(Cnt);
  1422.       Until (Cnt=256) or HungUpOn;
  1423.       WriteStr(^M^P'Press '^R'[Return]:');
  1424.     End;
  1425.  
  1426.     Procedure DisplayNodeInformation;
  1427.     Begin
  1428.          If FileSize(Fn)=0 then Exit;
  1429.          Seek(Fn,0);
  1430.          I:=0;
  1431.          While Not Eof(Fn) do
  1432.            Begin
  1433.              Inc(I);
  1434.              Read(Fn,Node);
  1435.              ShowNode;
  1436.            End;
  1437.          WriteStr(^M^P'Press '^R'[Return]:');
  1438.     End;
  1439.  
  1440.     Procedure InitializeThisStuff;
  1441.     Begin
  1442.          Assign(Fn,ConfigSet.ForumDi+'NodeList.BBS');
  1443.          If Exist(ConfigSet.ForumDi+'NodeList.BBS') then Reset(FN)
  1444.             Else
  1445.          ReWrite(Fn);
  1446.     End;
  1447.  
  1448.     Procedure AddNode;
  1449.     Begin
  1450.          ClearScr;
  1451.          WriteHdr('Add a node');
  1452.          FillChar(Node,SizeOf(Node),0);
  1453.          WriteStr('Enter the Node Password:');
  1454.          If input='' then Exit;
  1455.          Node.Pass:=Input;
  1456.          WriteStr('Enter the Node Name:');
  1457.          If Input='' then Exit;
  1458.          Node.Name:=Input;
  1459.          WriteLn(^M^S^G'Do NOT include any "-"''s or "("''s for the phone number!'^G^M);
  1460.          WriteStr('Enter the Node Phone Number:');
  1461.          If Input='' then Exit;
  1462.          Node.Phone:=Input;
  1463.          WriteStr('Enter the Node''s Baud Rate (ex: 38400) :');
  1464.          If Input='' then Exit;
  1465.          If Input='1200' then Node.baud:=1200;
  1466.          If input='2400' then Node.baud:=2400;
  1467.          If Input='4800' then Node.baud:=4800;
  1468.          if Input='9600' then Node.Baud:=9600;
  1469.          If Input='19200' then Node.Baud:=19200;
  1470.          If Input='38400' then Node.baud:=38400;
  1471.          WriteLn(^M^S'The node ID address is your NETWORK id. It will be something like');
  1472.          WriteLn(^S'1:100, or something along those lines. (NOTE: Hub ID is same as each Node)'^M);
  1473.          WriteStr('Enter Node ID Address:');
  1474.          If Input='' then Exit;
  1475.          Node.Node:=Input;
  1476.          ClearScr;
  1477.          WriteLn(^S'Now we are going to pick the Base ID''s to be networked. Each message base');
  1478.          WriteLn(^S'That is networked will have a UNIQUE Base ID. This ID tells ViSiON Which Bases');
  1479.          WriteLn(^S'to network. Enter each base ID, when you are done, enter a "0".'^M);
  1480.          Repeat
  1481.                WriteStr('Base ID:');
  1482.                I:=Valu(Input);
  1483.                If (I>0) and (I<256) then Node.BaseSelection[I]:=True
  1484.                   Else
  1485.                If I<>0 then WriteLn(^M^S^G'Invalid Range! Valid Ranges are from 1-255!'^M);
  1486.          Until (I=0) or HungUpOn;
  1487.          Write(^M'Adding Node to List...');
  1488.          Seek(Fn,FileSize(Fn));
  1489.          Write(Fn,Node);
  1490.          WriteLn('Completed!');
  1491.          WriteStr(^M^R'Press '^R'[Return]:');
  1492.     End;
  1493.  
  1494.     Procedure DeleteNode;
  1495.     Begin
  1496.          ClearScr;
  1497.          WriteStr('Which Node to Delete [1-'+strr(FileSize(Fn))+']:');
  1498.          I:=Valu(Input);
  1499.          If (I<1) or (I>FileSize(Fn)) then Exit;
  1500.          Write(^M'Deleting Node...');
  1501.          Dec(i);
  1502.          Cnt:=I;
  1503.          While Cnt<FileSize(Fn)-1 Do
  1504.          Begin
  1505.               Seek(Fn,Cnt+1);
  1506.               Read(Fn,Node);
  1507.               Seek(Fn,Cnt);
  1508.               Write(Fn,Node);
  1509.               Inc(Cnt);
  1510.          End;
  1511.          Seek(Fn,FileSize(Fn)-1);
  1512.          Truncate(Fn);
  1513.          Close(Fn);
  1514.          Assign(Fn,ConfigSet.ForumDi+'NodeList.BBS');
  1515.          Reset(Fn);
  1516.          WriteLn('Deleted!');
  1517.          WriteStr(^M^R'Press '^P'[Return]:');
  1518.     End;
  1519.  
  1520.     Procedure EditNode;
  1521.     Var NodeNum:Integer;
  1522.  
  1523.     Procedure GetPhoneNum;
  1524.     Begin
  1525.          ClearScr;
  1526.          WriteStr('Enter the New Phone Number:');
  1527.          If Input<>'' then Node.Phone:=Input;
  1528.     End;
  1529.  
  1530.     Procedure GetBaud;
  1531.     Begin
  1532.          ClearScr;
  1533.          WriteStr('Enter the NEW baud rate for this board:');
  1534.          If Input='1200' then Node.Baud:=1200
  1535.             Else
  1536.          if Input='2400' then Node.baud:=2400
  1537.             Else
  1538.          If Input='4800' then Node.Baud:=4800
  1539.             Else
  1540.          If Input='9600' then Node.Baud:=9600
  1541.             Else
  1542.          If Input='19200' then Node.baud:=19200
  1543.             Else
  1544.          If Input='38400' then Node.Baud:=38400;
  1545.     End;
  1546.  
  1547.     Procedure GetName;
  1548.     Begin
  1549.          ClearScr;
  1550.          WriteStr('Enter the New Node Name:');
  1551.          If Input<>'' then Node.Name:=Input;
  1552.     End;
  1553.  
  1554.     Procedure NodePassword;
  1555.     Begin
  1556.          ClearScr;
  1557.          WriteStr('Enter the New Node Password:');
  1558.          If Input<>'' then Node.Pass:=Input;
  1559.     End;
  1560.  
  1561.     Procedure NodeIdNumber;
  1562.     Begin
  1563.          ClearScr;
  1564.          WriteStr('Enter the NEW Node ID Number:');
  1565.          If Input<>'' then Node.Node:=Input;
  1566.     End;
  1567.  
  1568.     Procedure NetBases;
  1569.     Begin
  1570.          ClearScr;
  1571.          WriteLn(^S'To change the status of a networked base, enter the BASE ID that you wish');
  1572.          WriteLn(^S'to change. I.e. if Base 1 was networked, and you wish to not carry it anymore');
  1573.          WriteLn(^S'then you would enter a "1". Enter a "0" when you are done.'^M);
  1574.          Repeat
  1575.                WriteStr('Base ID to Change:');
  1576.                I:=Valu(Input);
  1577.                If (I>0) and (I<256) then
  1578.                   Begin
  1579.                        Node.BaseSelection[I]:=Not Node.BaseSelection[I];
  1580.                        If Node.BaseSelection[I] then Writeln('Base ID:',I,' WILL be networked.')
  1581.                        Else
  1582.                        WriteLn('Base ID:',i,' will NOT be networked.');
  1583.                   End;
  1584.          Until (I=0) or HungUpOn;
  1585.     End;
  1586.  
  1587.     Begin
  1588.          ClearScr;
  1589.          WriteStr('Enter the Node to Edit [1-'+strr(FileSize(Fn))+']:');
  1590.          I:=Valu(Input);
  1591.          If (I<1) or (I>FileSize(Fn)) then Else
  1592.           Begin
  1593.                Seek(Fn,I-1);
  1594.                Read(Fn,Node);
  1595.                NodeNum:=I-1;
  1596.                  Repeat
  1597.                    ClearScr;
  1598.                    WriteHdr('Node Editing');
  1599.                    WriteLn(^P'P) Phone Number'^M^P'B) Baud Rate'^M^P'N) Node Name');
  1600.                    WriteLn(^P'V) View Node'^M^P'W) Node Password'^M^P'I) Node ID Number');
  1601.                    WriteLn(^P'S) Net bases'^M^P'Q) Quit Editing'^M);
  1602.                    WriteStr('Choice:');
  1603.                    If Input='' then Input:='Q';
  1604.                    C:=UpCase(Input[1]);
  1605.                    Case C Of
  1606.                      'P':GetPhoneNum;
  1607.                      'B':GetBaud;
  1608.                      'N':GetName;
  1609.                      'V':ShowNode;
  1610.                      'W':NodePassword;
  1611.                      'I':NodeIDNumber;
  1612.                      'S':NetBases;
  1613.                    End;
  1614.                  Until (C='Q') or HungUpOn;
  1615.                Seek(Fn,NodeNum);
  1616.                Write(Fn,Node);
  1617.           End;
  1618.           C:='U';
  1619.          End;
  1620.  
  1621. Begin
  1622.      InitializeThisStuff;
  1623.      Repeat
  1624.            ClearScr;
  1625.            WriteHdr('Node List Maintenance');
  1626.            WriteLn(^P'S) Show All Nodes');
  1627.            WriteLn(^P'E) Edit a node');
  1628.            WriteLn(^P'D) Delete a Node');
  1629.            WriteLn(^P'A) Add a node');
  1630.            WriteLn(^P'Q) Quit Node Editor'^M);
  1631.            WriteStr('Choice:');
  1632.            If Input='' then Input:='Q';
  1633.            C:=UpCase(Input[1]);
  1634.            Case C of
  1635.              'S':DisplayNodeInformation;
  1636.              'E':EditNode;
  1637.              'D':DeleteNode;
  1638.              'A':AddNode;
  1639.            End;
  1640.      Until (C='Q') or HungUpOn;
  1641.      Close(Fn);
  1642. End;
  1643.  
  1644.  
  1645. procedure makeuser;
  1646. var u:userrec;
  1647.     un,ln,txx:integer;
  1648. begin
  1649.   writehdr ('Add a user');
  1650.   writestr ('Name:');
  1651.   if length(input)=0 then exit;
  1652.   if lookupuser(input)<>0 then begin
  1653.     writestr ('Sorry!  Already exists!');
  1654.     exit
  1655.   end;
  1656.   u.handle:=input;
  1657.   u.realname:='';
  1658.   writestr ('Password:');
  1659.   u.password:=input;
  1660.   writestr ('Level:');
  1661.   if length(input)=0 then exit;
  1662.   u.level:=valu(input);
  1663.   for txx:=1 to 32 do u.confset[txx]:=0;
  1664.   u.phonenum:='8005551212';
  1665.   u.usernote:='New User';
  1666.   un:=adduser(u);
  1667.   if un=-1 then begin
  1668.     writestr ('Sorry, no room for new users!');
  1669.     exit
  1670.   end;
  1671.   ln:=u.level;
  1672.   if ln<1 then ln:=1;
  1673.   if ln>100 then ln:=100;
  1674.   u.timetoday:=configset.usertim[ln];
  1675.   writeufile (u,un);
  1676.   writestr ('User added as #'+strr(un)+'.');
  1677.   writelog (2,8,u.handle)
  1678. end;
  1679.  
  1680. procedure infoformhunt;
  1681. var tp:mstr;
  1682.     info:integer;
  1683. begin
  1684.   writestr ('User to search for [CR=all users]:');
  1685.   writeln (^M);
  1686.   tp:=input;
  1687.   writestr('Infoform # view [1-5]: [1]:*');
  1688.   if input='' then input:='1';
  1689.   info:=valu(input);
  1690.   if (info>0) and (info<6) then
  1691.   showinfoforms (tp,info)
  1692. end;
  1693.  
  1694. procedure donations;
  1695. var fn:lstr;
  1696. begin
  1697.   fn:=configset.textfiledi+'Donation';
  1698.   if exist (fn)
  1699.     then printfile (fn)
  1700.     else begin
  1701.       writestr ('I''m sorry, no information is currently available.');
  1702.       if issysop
  1703.         then writestr (
  1704. 'Sysop:  To create donation information text, make a file called '+fn)
  1705.     end
  1706. end;
  1707.  
  1708. procedure viewsyslog;
  1709. var n:integer;
  1710.     l:logrec;
  1711.  
  1712.   function lookupsyslogdat (m,s:integer):integer;
  1713.   var cnt:integer;
  1714.   begin
  1715.     for cnt:=1 to numsyslogdat do with syslogdat[cnt] do
  1716.       if (menu=m) and (subcommand=s) then begin
  1717.         lookupsyslogdat:=cnt;
  1718.         exit
  1719.       end;
  1720.     lookupsyslogdat:=0
  1721.   end;
  1722.  
  1723.   function firstentry:boolean;
  1724.   begin
  1725.     firstentry:=(l.menu=0) and (l.subcommand in [1..2])
  1726.   end;
  1727.  
  1728.   procedure backup;
  1729.   begin
  1730.     while n<>0 do begin
  1731.       n:=n-1;
  1732.       seek (logfile,n);
  1733.       read (logfile,l);
  1734.       if firstentry then exit
  1735.     end;
  1736.     n:=-1
  1737.   end;
  1738.  
  1739.   procedure showentry (includedate:boolean);
  1740.   var q:String;
  1741.       p:integer;
  1742.   begin
  1743.     q:=^S+'[ '+^R+syslogdat[lookupsyslogdat(l.menu,l.subcommand)].text;
  1744.     p:=pos('%',q);
  1745.     if p<>0 then q:=copy(q,1,p-1)+l.param+copy(q,p+1,255);
  1746.     repeat
  1747.       q:=q+'.';
  1748.     until length(q)>48;
  1749.     q:=q+^S+' ]   '+^P+'[ '+^A;
  1750.     if includedate then q:=q+datestr(l.when)+' at '+TimeStr(L.When)+^P' ]'
  1751.     Else
  1752.     q:=q+timestr(l.when)+^P+' ]';
  1753.     writeln (q)
  1754.   end;
  1755.  
  1756. var b:boolean;
  1757. begin
  1758.   writehdr ('View system log');
  1759.   writeln ('Press space to advance to the previous caller, X to abort.');
  1760.   writeln;
  1761.   writelog (2,6,'');
  1762.   n:=filesize(logfile);
  1763.   repeat
  1764.     clearbreak;
  1765.     writeln (^M);
  1766.     backup;
  1767.     if n=-1 then exit;
  1768.     seek (logfile,n);
  1769.     read (logfile,l);
  1770.     showentry (true);
  1771.     b:=false;
  1772.     while not (eof(logfile) or break or xpressed or b) do begin
  1773.       read (logfile,l);
  1774.       b:=firstentry;
  1775.       if not b then showentry (false);
  1776.     end
  1777.   until xpressed
  1778. end;
  1779.  
  1780. procedure delsyslog;
  1781. begin
  1782.   writestr ('Delete system log: Confirm:');
  1783.   if not yes then exit;
  1784.   if (not local) then begin
  1785.     writeln(^M'You may only delete the System log locally!'^M);
  1786.     exit;
  1787.   end;
  1788.   close (logfile);
  1789.   rewrite (logfile);
  1790.   writeln (^M'System log deleted.');
  1791.   writelog (2,7,unam)
  1792. end;
  1793.  
  1794. procedure showallforms;
  1795. var info:integer;
  1796. begin
  1797.   writestr('Which infoform to view [1-5]: [1]:*');
  1798.   if input='' then input:='1';
  1799.   info:=valu(input);
  1800.   if (info>0) and (info<6) then
  1801.   showinfoforms ('',info)
  1802. end;
  1803.  
  1804. procedure mainhelp;
  1805. begin
  1806.   help ('Mainmenu.hlp')
  1807. end;
  1808.  
  1809. procedure otherbbs;
  1810. var blfile:file of bbsrec;
  1811.     card,ugbot,p:lstr;
  1812.     b:bbsrec;
  1813.  
  1814.    function numbbses:integer;
  1815.    begin
  1816.      numbbses:=filesize(blfile)
  1817.    end;
  1818.  
  1819.    procedure seekblfile (n:integer);
  1820.    begin
  1821.      seek (blfile,n-1);
  1822.    end;
  1823.  
  1824.    function numbbs:integer;
  1825.    begin
  1826.      numbbs:=filesize (blfile);
  1827.    end;
  1828.  
  1829.    procedure getstring (t:lstr; var m; buf:integer);
  1830.    var q:lstr absolute m;
  1831.        mm:lstr;
  1832.    begin
  1833.      writeln (^R'Old '^V,t,^R': '^S,q,^R);
  1834.      buflen:=buf;
  1835.      writestr ('Enter new '+^V+t+^P+' [CR/no change]:');
  1836.      mm:=input;
  1837.      if length(mm)<>0 then q:=mm;
  1838.      writeln
  1839.    end;
  1840.  
  1841.     procedure listbbs;
  1842.     var cnt,b1,b2:integer;
  1843.         showedz:boolean;
  1844.     begin
  1845.      writehdr ('BBS List');
  1846.      reset (blfile);
  1847.      if ioresult<>0 then begin
  1848.       writeln ('There are no bbs! you may add your own!');
  1849.       exit;
  1850.      end
  1851.      else begin
  1852.      parserange (numbbs,b1,b2);
  1853.     {writestr ('Display complete Description [y/n]? *');
  1854.      writeln;
  1855.      howedz:=true;
  1856.      if upcase(input[1])='N' then showedz:=false;}
  1857.      cls;
  1858.      writehdr ('ViSiON BBS Listing');
  1859.       colorfb(3,0);
  1860.       writeln (^R'╒═════════╤══════════════╤═════════╤════════════════════════════════════════╕');
  1861.       writeln (^R'│'^A'Software '^R'│'^A' Phone Number '^R'│'^A' Max BPS '^R'│               '^A+
  1862. 'Board Name               '^R'│');
  1863.       writeln (^R'╞═════════╪══════════════╪═════════╪════════════════════════════════════════╡');
  1864.       if b1>0 then
  1865.       for cnt := b1 to b2 do
  1866.       begin
  1867.       if xpressed then exit;
  1868.       seekblfile(cnt);
  1869.       read(blfile,b);
  1870.         tab (^R'│ '^S+b.ware,12);
  1871.         tab (^R'│ '^U+b.phone,17);
  1872.         tab (^R'│ '^P+b.baud,12);
  1873.         tab (^R'│ '^U+b.name,43);
  1874.         writeln (^R'│');
  1875.  
  1876.         If break Then begin
  1877.       writeln (^R'╘═════════╧══════════════╧═════════╧════════════════════════════════════════╛');
  1878.  
  1879.             exit
  1880.         end;
  1881.       End;
  1882.       writeln (^R'╘═════════╧══════════════╧═════════╧════════════════════════════════════════╛');
  1883.  
  1884.     End;
  1885.  
  1886.  
  1887.       end;
  1888.  
  1889.      Procedure SD;
  1890.      Begin
  1891.       ANSiColor(8);
  1892.       WriteLn('█');
  1893.      End;
  1894.  
  1895.     procedure addbbs;
  1896.     begin
  1897.      ClearScr;
  1898.      WriteLn(^R'╒════════════════════════════════'^P'['^U'Add a BBS Entry'^P']'^R'═══╕');
  1899.      Write(^R'│  '^S'BBS Name                                          '^R'│');SD;
  1900.      write(^R'│  '^P':                                                 '^R'│');SD;
  1901.      Write(^R'│  '^S'BBS Number                                        '^R'│');sd;
  1902.      Write(^R'│  '^P':                                                 '^R'│');sd;
  1903.      write(^R'│  '^S'Highest Baud Rate                                 '^R'│');sd;
  1904.      Write(^R'│  '^P':                                                 '^R'│');sd;
  1905.      Write(^R'│  '^S'Software ('^U'ViSiON'^S')!                                '^R'│');sd;
  1906.      Write(^R'│  '^P':                                                 '^R'│');sd;
  1907.      Write(^R'╘════════════════════════════════════════════════════╛');sd;
  1908.      WriteLn('  ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀');
  1909.      GoXy(6,3);
  1910.      buflen:=40;
  1911.      writestr ('*');
  1912.      b.name:=input;
  1913.      GoXy(6,5);
  1914.      buflen:=12;
  1915.      writestr ('*');
  1916.      b.phone:=input;
  1917.      GoXy(6,7);
  1918.      buflen:=5;
  1919.      writestr ('*');
  1920.      b.baud:=input;
  1921.      GoXy(6,9);
  1922.      buflen:=8;
  1923.      writestr ('*');
  1924.      b.ware:=input;
  1925.      writeln;
  1926.      b.leftby:=unam;
  1927.      if (length(b.phone)>0) and (length(b.name)>0) and (length(b.baud)>0)
  1928.      and (length(b.ware)>0) then begin
  1929.       if not exist ('BBSLIST.DAT') then rewrite (blfile) ;
  1930.       seekblfile (numbbses+1);
  1931.       write (blfile,b);
  1932.       writeln (^M^S'Entry Added!'^R^M);
  1933.      end else
  1934.      writeln (^M^S'Bad Entry!'^R^M);
  1935.      end;
  1936.  
  1937.   procedure changebbs;
  1938.   var q,spock:integer;
  1939.       doodzdomain:char;
  1940.  
  1941.    procedure showbbs (b:bbsrec);
  1942.    begin
  1943.    writeln (^M^R'[1]... Name:     '^S,b.name,
  1944.             ^M^R'[2]... Number:   '^S,b.phone,
  1945.             ^M^R'[3]... Max Baud: '^S,b.baud,
  1946.             ^M^R'[4]... Software: '^S,b.ware,
  1947.             ^M^R'[Q]... Quit');
  1948.    end;
  1949.  
  1950.    begin
  1951.        writehdr ('Change an Entry');
  1952.        writestr (^M^R'Entry to Change ['^S'?'^R']: &');
  1953.        if input[1]='?' then listbbs;
  1954.        spock:=valu(input);
  1955.        if spock<1 then exit;
  1956.        if spock>numbbs then exit;
  1957.        seekblfile (spock);
  1958.        read (blfile,b);
  1959.        if not (match (b.leftby,unam)) then begin
  1960.         writeln (^M'You didn''t make the entry!'^M);
  1961.         exit;
  1962.        end;
  1963.        repeat
  1964.        showbbs (b);
  1965.        writestr ('Edit Command: *');
  1966.        doodzdomain:=upcase(input[1]);
  1967.        case doodzdomain of
  1968.         '1':getstring ('Name',b.name,48);
  1969.         '2':getstring ('Number',b.phone,12);
  1970.         '3':getstring ('Max Baud',b.baud,4);
  1971.         '4':getstring ('Software',b.ware,4);
  1972.         'Q':;
  1973.        end;
  1974.        until doodzdomain='Q';
  1975.        seek (blfile,spock-1);
  1976.        write (blfile,b);
  1977.        close (blfile);
  1978.       end;
  1979.  
  1980.     Procedure Deletebbs;
  1981.       Var bud,cnt,n:Integer;
  1982.         f:File;
  1983.         KKOOL:bbsrec;
  1984.       Begin
  1985.       Writehdr ('Delete a BBS');
  1986.        Writestr ('BBS record # to delete? :');
  1987.        if input='' then exit;
  1988.        bud:=valu(input);
  1989.        if bud>numbbs then exit;
  1990.        n:=bud;
  1991.         If n=0 Then exit;
  1992.      seek (blfile,n-1);
  1993.      read (blfile,kkool);
  1994.  
  1995.         writestr('Delete '+^S+kkool.name+^P+'? *');
  1996.         if ((match (unam,kkool.leftby))=false) and (issysop=false) then exit;
  1997.  
  1998.         If Not yes Then exit;
  1999.         For cnt:=n+1 To numbbs Do Begin
  2000.           seekblfile(cnt);
  2001.           Read(blfile,kkool);
  2002.           seekblfile(cnt-1);
  2003.           Write(blfile,kkool)
  2004.         End;
  2005.         seekblfile(numbbs);
  2006.         Truncate(blfile);
  2007.         writestr(^M'Deleted.');
  2008.       End;
  2009.  
  2010.  
  2011.   procedure bbslistsysop;
  2012.   begin
  2013.      writeln;
  2014.      repeat
  2015.       ugbot:=' ';
  2016.       writeln  (^R'('^S'D'^R')elete an Entry');
  2017.       writeln  (^R'('^S'C'^R')hange an Entry');
  2018.       writeln  (^R'('^S'Q'^R')uit'^M);
  2019.       writestr ('[BBS List Sysop Command]:');
  2020.       ugbot:=upstring(input);
  2021.       case ugbot[1] of
  2022.        'D':deletebbs;
  2023.        'C':changebbs;
  2024.        'S':begin
  2025.            end;
  2026.        'T':begin
  2027.            end;
  2028.        'Q':;
  2029.       end;
  2030.      until (ugbot[1]='Q');
  2031.     end;
  2032.  
  2033. label exit;
  2034. var q:integer;
  2035. begin
  2036.     assign (blfile,'BBSLIST.DAT');
  2037.     WriteHdr('BBS Listings...');
  2038.     repeat
  2039.      q:=menu ('BBS List','BBSLIST','LADC%QI');
  2040.      writeln;
  2041.      case q of
  2042.       1:listbbs;
  2043.       2:addbbs;
  2044.       3:deletebbs;
  2045.       4:changebbs;
  2046.       5:bbslistsysop;
  2047.       6:goto exit;
  2048.      end;
  2049.      until (hungupon) or (q=6);
  2050.     exit:
  2051.     close (blfile);
  2052. end;
  2053.  
  2054. procedure readerrlog;
  2055. begin
  2056.   if exist (configset.forumdi+'Errlog')
  2057.     then printfile (configset.forumdi+'Errlog.')
  2058.     else writestr ('No error file!')
  2059. end;
  2060.  
  2061. procedure showad;
  2062. var fn:lstr;
  2063. begin
  2064.   fn:=configset.textfiledi+'VISION.AD';
  2065.   if exist (fn) then printfile (fn)
  2066. end;
  2067.  
  2068. procedure setlastcall;
  2069.  
  2070.   function digit (k:char):boolean;
  2071.   begin
  2072.     digit:=ord(k) in [48..57]
  2073.   end;
  2074.  
  2075.   function validtime (inp:sstr):boolean;
  2076.   var c,s,l:integer;
  2077.       d1,d2,d3,d4:char;
  2078.       ap,m:char;
  2079.   begin
  2080.     validtime:=false;
  2081.     l:=length(inp);
  2082.     if (l<7) or (l>8) then exit;
  2083.     c:=pos(':',inp);
  2084.     if c<>l-5 then exit;
  2085.     s:=pos(' ',inp);
  2086.     if s<>l-2 then exit;
  2087.     d2:=inp[c-1];
  2088.     if l=7
  2089.       then d1:='0'
  2090.       else d1:=inp[1];
  2091.     d3:=inp[c+1];
  2092.     d4:=inp[c+2];
  2093.     ap:=upcase(inp[s+1]);
  2094.     m:=upcase(inp[s+2]);
  2095.     if d1='1' then if d2>'2' then d2:='!';
  2096.     if (d1>='0') and (d1<='1') and digit(d2) and (d3>='0') and (d3<='5')
  2097.        and digit(d4) and ((ap='A') or (ap='P')) and (m='M')
  2098.          then validtime:=true
  2099.   end;
  2100.  
  2101.   function validdate (inp:sstr):boolean;
  2102.   var k,l:char;
  2103.  
  2104.     function gchar:char;
  2105.     begin
  2106.       if length(inp)=0 then begin
  2107.         gchar:='?';
  2108.         exit
  2109.       end;
  2110.       gchar:=inp[1];
  2111.       delete (inp,1,1)
  2112.     end;
  2113.  
  2114.   begin
  2115.     validdate:=false;
  2116.     k:=gchar;
  2117.     l:=gchar;
  2118.     if not digit(k) then exit;
  2119.     if l='/'
  2120.       then if k='0'
  2121.         then exit
  2122.         else
  2123.       else begin
  2124.         if k>'1' then exit;
  2125.         if not digit(l) then exit;
  2126.         if (l>'2') and (k='1') then exit;
  2127.         l:=gchar;
  2128.         if l<>'/' then exit
  2129.       end;
  2130.     k:=gchar;
  2131.     l:=gchar;
  2132.     if l='/'
  2133.       then if k='0'
  2134.         then exit
  2135.         else
  2136.       else begin
  2137.         if k>'3' then exit;
  2138.         if not digit(l) then exit;
  2139.         if (k='3') and (l>'1') then exit;
  2140.         l:=gchar;
  2141.         if l<>'/' then exit
  2142.       end;
  2143.     if digit(gchar) and digit(gchar) then validdate:=true
  2144.   end;
  2145.  
  2146. begin
  2147.   writeln (^M'Your last call was: '^S,datestr(laston),' at ',timestr(laston));
  2148.   writestr (^M'Enter new date (mm/dd/yy):');
  2149.   if length(input)>0
  2150.     then if validdate (input)
  2151.       then laston:=dateval(input)+timepart(laston)
  2152.       else writestr ('Invalid date!');
  2153.   writestr (^M'Enter new time (hh:mm am/pm):');
  2154.   if length(input)>0
  2155.     then if validtime(input)
  2156.       then laston:=timeval(input)+datepart(laston)
  2157.       else writestr ('Invalid time!')
  2158. end;
  2159.  
  2160. procedure removeallforms;
  2161. var cnt,ndel:integer;
  2162.     u:userrec;
  2163. begin
  2164.   writestr ('Erase ALL info-forms:  Are you sure? *');
  2165.   if not yes then exit;
  2166.   writeurec;
  2167.   writestr (^M'Erasing... please stand by...');
  2168.   ndel:=0;
  2169.   for cnt:=1 to numusers do begin
  2170.     if (cnt mod 10)=0 then write (cnt,', ');
  2171.     seek (ufile,cnt);
  2172.     read (ufile,u);
  2173.     if u.infoform>=0 then
  2174.       deletetext (u.infoform);
  2175.       u.infoform:=-1;
  2176.       if u.infoform2>=0 then deletetext(u.infoform2);
  2177.       u.infoform2:=-1;
  2178.       if u.infoform3>0 then deletetext(u.infoform3);
  2179.       u.infoform3:=-1;
  2180.       if u.infoform4>0 then deletetext(u.infoform4);
  2181.       u.infoform4:=-1;
  2182.       if u.infoform5>0 then deletetext(u.infoform5);
  2183.       u.infoform5:=-1;
  2184.       seek (ufile,cnt);
  2185.       write (ufile,u);
  2186.   end;
  2187.   writeln ('done.');
  2188.   writestr (^M'All '+strr(numusers)+' forms erased.');
  2189.   readurec
  2190. end;
  2191.  
  2192. procedure showscreens;
  2193. var i:integer;
  2194. begin
  2195. repeat
  2196.       clearscr;
  2197.       writehdr('The Ansi Gallery');
  2198.       writeln(^M^P'[A] - '^A'Show ASCII Welcome Screen');
  2199.       writeln(^P'[1-',configset.numwelcome,'] - '^A'Show Ansi Welcome Screen #xx');
  2200.       writeln(^P'[Q] - '^A'Exit this section');
  2201.       writestr(^M^R'Selection:');
  2202.       if input='' then input:='Q';
  2203.       if match(input,'A') then printfile(configset.textfiledi+'Welcome.Asc') else
  2204.         if not match(input,'Q') then begin i:=valu(input);
  2205.         if (i>0) and (i<=configset.numwelcome) then printfile(configset.textfiledi+'Welcome.'+strr(i))
  2206.         else writeln(^M^S'Invalid Screen!');
  2207.         end;
  2208.         if not match(input,'Q') then begin
  2209.            buflen:=0;
  2210.            writestr(^M^R'Press [Return]*');
  2211.         end;
  2212.       until match(input,'Q') or hungupon;
  2213. end;
  2214.  
  2215.  Procedure showlastcallers;
  2216.     Var qf:File Of lastrec;
  2217.       cnt:Integer;
  2218.       l:lastrec;
  2219.     Begin
  2220.       If ConfigSet.LastLeve>Ulvl then Exit;
  2221.       Assign(qf,'Callers');
  2222.       Reset(qf);
  2223.       If IOResult=0 Then Begin
  2224.         ClearScr;
  2225.         writehdr('Recent Caller List');
  2226.     writehdr('       User''s Name                    Date        Time        Speed     ');
  2227.         For cnt:=0 To FileSize(qf)-1 Do begin
  2228.           Read(qf,l);
  2229.           Write('  ');
  2230.           ANSiCOLOR(11);
  2231.           Tabul(l.name,39);
  2232.           ansicolor(3);
  2233.           Tabul(datestr(l.when),12);
  2234.           ansicolor(3);
  2235.           Tabul(timestr(l.when),12);
  2236.           ansicolor(9);
  2237.           Tabul(strr(l.lastbps)+' Bps',12);
  2238.           WriteLn;
  2239.           if Break then Begin
  2240.              Close(qf);
  2241.              Exit;
  2242.              End;
  2243.           End;
  2244.           Close(qf)
  2245.         End;
  2246.         End;
  2247.  
  2248. Procedure JumpConference;
  2249. Var I:Integer;
  2250. Begin
  2251.    If configset.numconfs<2 then Begin
  2252.     exit;
  2253.     end;
  2254.    Urec.Conf[1]:=True;
  2255.    WriteHdr('Conference Selections');
  2256.    WriteLn(^P'['^R'1'^P'] '^S+ConfigSet.Conf1);
  2257.    If (ConfigSet.NumConfs>1) and Urec.Conf[2] then
  2258.    WriteLn(^P'['^R'2'^P'] '^S+ConfigSet.Conf2);
  2259.    If (ConfigSet.NumConfs>2) and Urec.Conf[3] then
  2260.    WriteLn(^P'['^R'3'^P'] '^S+ConfigSet.Conf3);
  2261.    If (ConfigSet.NumConfs>3) and Urec.Conf[4] then
  2262.    WriteLn(^P'['^R'4'^P'] '^S+ConfigSet.Conf4);
  2263.    If (ConfigSet.NumConfs>4) and Urec.Conf[5] then
  2264.    WriteLn(^P'['^R'5'^P'] '^S+ConfigSet.Conf5);
  2265.    WriteStr(^M^R'Conference '^P'['^A'1'^P']'^R':');
  2266.    If Input='' then Input:='1';
  2267.    I:=Valu(Input);
  2268.    If (I<1) or (I>ConfigSet.NumConfs) or not Urec.Conf[I] then
  2269.      WriteLn(^M^G'Invalid Choice!')
  2270.      Else
  2271.    Begin
  2272.      CurrentConference:=I;
  2273.      Case I of
  2274.        1:WriteLn(^M^R'Conference: '^P'['^A+ConfigSet.Conf1+' #'+strr(currentconference)+^P']'^R' Joined...');
  2275.        2:WriteLn(^M^R'Conference: '^P'['^A+ConfigSet.Conf2+' #'+strr(currentconference)+^P']'^R' Joined...');
  2276.        3:WriteLn(^M^R'Conference: '^P'['^A+ConfigSet.Conf3+' #'+strr(currentconference)+^P']'^R' Joined...');
  2277.        4:WriteLn(^M^R'Conference: '^P'['^A+ConfigSet.Conf4+' #'+strr(currentconference)+^P']'^R' Joined...');
  2278.        5:WriteLn(^M^R'Conference: '^P'['^A+ConfigSet.Conf5+' #'+strr(currentconference)+^P']'^R' Joined...');
  2279.      End;
  2280.    End;
  2281.    Urec.LastConf:=CurrentConference;
  2282. End;
  2283.  
  2284. procedure TopTen(eatshit:byte);
  2285.  
  2286.       type HighestPCR=record
  2287.              Name:mstr;
  2288.              PCR:longint;
  2289.              end;
  2290.  
  2291.       Type Tp=Array[1..10] of HighestPCR;
  2292.   Var done:boolean;
  2293.       TMPrec:userrec;
  2294.       Uploaders,LameUploaders,Downloaders,LameDownloaders,Posters,GoodUls,
  2295.       BadUls,GoodDls,BadDls,LamePosters,GoodPosts,BadPosts,GoodCalls,
  2296.       BadCalls:Tp;
  2297.       TmpPost:highestpcr;
  2298.       X1:Integer;
  2299.  
  2300.  Procedure InitIt(where:byte);
  2301.  Var A,B,C,D,E,Cnt,UpToDown:LongInt;
  2302.  
  2303.      Procedure SortIt(Var ArofIt:Tp; Tempo:LongInt; UpOrDown:Boolean);
  2304.      Var Cnt,I,quick:Integer;
  2305.      Begin
  2306.      If where=0 then quick:=10 Else Quick:=5;
  2307.        Done:=False;
  2308.        For Cnt:=1 to quick Do
  2309.        Begin
  2310.          If UpOrDown then
  2311.            Begin
  2312.            If not Done and (Tempo>ArofIt[Cnt].Pcr) then
  2313.            Begin
  2314.              If Cnt<quick then
  2315.                For I:=quick-1 downto Cnt do ArofIt[I+1]:=ArofIt[I];
  2316.              ArofIt[Cnt].Name:=TmpRec.Handle;
  2317.              ArofIt[Cnt].PCR:=Tempo;
  2318.              Done:=True;
  2319.            End;
  2320.            End
  2321.          Else
  2322.            If Not Done and (Tempo<ArofIt[Cnt].PCR) then
  2323.            Begin
  2324.             If Cnt>1 then
  2325.               For I:=quick-1 downto cnt do ArofIt[I+1]:=ArofIt[I];
  2326.               ArofIt[Cnt].Name:=TmpRec.Handle;
  2327.               ArofIt[Cnt].PCR:=Tempo;
  2328.               Done:=True;
  2329.             End;
  2330.        End;
  2331.      End;
  2332.  
  2333.      begin
  2334.      ClearScr;
  2335.      If eatshit=0 then Writehdr ('Calculating Statistics');
  2336.      If eatshit=1 then writehdr ('Highest/Lowest Posts');
  2337.      If eatshit=2 then writehdr ('Highest Uploads/Downloads');
  2338.        for cnt:=1 to 10 do begin
  2339.         Posters[cnt].pcr:=0;
  2340.         posters[cnt].name:='';
  2341.         lamePosters[cnt].pcr:=maxint;
  2342.         lameposters[cnt].name:='';
  2343.         GoodPosts[Cnt].Name:='';
  2344.         GoodPosts[Cnt].PCR:=0;
  2345.         BadPosts[Cnt].Name:='';
  2346.         BadPosts[Cnt].Pcr:=MaxInt;
  2347.         GoodCalls[Cnt].Name:='';
  2348.         GoodCalls[Cnt].Pcr:=0;
  2349.         BadCalls[Cnt].Name:='';
  2350.         BadCalls[Cnt].Pcr:=MaxInt;
  2351.         Downloaders[cnt].pcr:=0;
  2352.         downloaders[cnt].name:='';
  2353.         lamedownloaders[cnt].pcr:=maxint;
  2354.         lamedownloaders[cnt].name:='';
  2355.                uploaders[cnt].pcr:=0;
  2356.         uploaders[cnt].name:='';
  2357.         lameuploaders[cnt].pcr:=maxint;
  2358.         lameuploaders[cnt].name:='';
  2359.         GoodUls[Cnt].Name:='';
  2360.         GoodUls[Cnt].PCR:=0;
  2361.         BadUls[Cnt].Name:='';
  2362.         BadUls[Cnt].PCR:=MaxInt;
  2363.         GoodDls[Cnt].Name:='';
  2364.         GoodDls[Cnt].PCR:=0;
  2365.         BadDls[Cnt].Name:='';
  2366.         BadDls[Cnt].PCR:=MaxInt;
  2367.        end;
  2368.      for cnt:=3 to numusers do begin
  2369.       seek(ufile,cnt-1);
  2370.       read(ufile,TmpRec);
  2371.       If where=0 then Begin
  2372.         if tmprec.numon>1 then
  2373.         begin
  2374.       D:=Ratio(TmpRec.Nbu,TmpRec.NumOn);
  2375.        Sortit(Posters,D,True);
  2376.        SortIt(LamePosters,D,False);
  2377.       d:=tmprec.UpKay;
  2378.        SortIt(Uploaders,D,True);
  2379.        SortIt(LameUploaders,D,False);
  2380.       d:=tmprec.DnKay;
  2381.        SortIt(Downloaders,D,True);
  2382.        SortIt(LameDownloaders,D,False);
  2383.       D:=TmpRec.Uploads;
  2384.        SortIt(GoodUls,D,True);
  2385.        SortIt(BadUls,D,False);
  2386.       D:=TmpRec.Downloads;
  2387.        SortIt(GoodDls,D,True);
  2388.        SortIt(BadDls,D,False);
  2389.        SortIt(GoodPosts,TmpRec.Nbu,True);
  2390.        SortIt(BadPosts,TmpRec.Nbu,False);
  2391.        End;
  2392.        SortIt(GoodCalls,TmpRec.NumOn,True);
  2393.        SortIt(BadCalls,TmpRec.NumOn,False);
  2394.          End Else
  2395.                  If Where=1 then Begin
  2396.                  if tmprec.numon>1 then Begin
  2397.                    D:=Ratio(TmpRec.Nbu,TmpRec.NumOn);
  2398.                     SortIt(GoodPosts,TmpRec.Nbu,True);
  2399.             SortIt(BadPosts,TmpRec.Nbu,False);
  2400.                    End;
  2401.                  End Else
  2402.                  If Where=2 then Begin
  2403.                  if tmprec.numon>1 then Begin
  2404.                  d:=tmprec.UpKay;
  2405.               SortIt(Uploaders,D,True);
  2406.              d:=tmprec.DnKay;
  2407.               SortIt(Downloaders,D,True);
  2408.                    End;
  2409.                   End;
  2410.          End;
  2411.            End;
  2412.  
  2413.      Procedure ShowSomething(TempOr:Tp; ToSay:Mstr; SayK:Byte);
  2414.      Var Cnt:Integer;
  2415.      Begin
  2416.        ClearScr;
  2417.        WriteHdr(ToSay);
  2418.        For Cnt:=1 to 10 Do
  2419.          Begin
  2420.            Tab(Strr(Cnt)+'.',4);
  2421.            Tab(TempOr[Cnt].Name,37);
  2422.            Write(TempOr[Cnt].PCR);
  2423.            if SayK=1 then Write('%');
  2424.            If SayK=2 then Write('K');
  2425.            WriteLn;
  2426.          End;
  2427.        WriteStr(^M^R'Press [Return]:');
  2428.      End;
  2429.  
  2430.      Procedure ViZWaY(TempOr:Tp; Tosay:Mstr; SayK:Byte; Whatit:Mstr); (* The Only Way *)
  2431.      Var number:Integer;
  2432.      Begin
  2433.        WriteLn(^S+ToSay+^M);
  2434.        For Number:=1 To 5 Do Begin
  2435.        Tabul(^P+Strr(number)+^S'. ',4);
  2436.        Tabul(^F+TempOr[number].Name,37);
  2437.        Write(^A);
  2438.        Write(TempOr[number].PCR);
  2439.          If sayK=1 then Write('%');
  2440.          If sayk=2 then Write('K');
  2441.        WriteLn(' '+whatit);
  2442.        End;
  2443.        WriteLn;
  2444.      End;
  2445.  
  2446.      Begin
  2447.      If eatshit=0 then Begin
  2448.      InitIt(0);
  2449.      Repeat
  2450.        ClearScr;
  2451.        WriteHdr('Top 10 Listing');
  2452.        WriteLn(^R'[1] '^P'Best Uploaders');
  2453.        WriteLn(^R'[2] '^P'Worst Uploaders');
  2454.        WriteLn(^R'[3] '^P'Best Downloaders');
  2455.        WriteLn(^R'[4] '^P'Worst Downloaders');
  2456.        WriteLn(^R'[5] '^P'Best Post/Call Ratios');
  2457.        WriteLn(^R'[6] '^P'Worst Post/Call Ratios');
  2458.        WriteLn(^R'[7] '^P'Best Uploaders in K-Bytes');
  2459.        WriteLn(^R'[8] '^P'Worst Uploaders in K-Bytes');
  2460.        WriteLn(^R'[9] '^P'Best Downloaders in K-Bytes');
  2461.        WriteLn(^R'[10] '^P'Worst Downloaders in K-Bytes');
  2462.        WriteLn(^R'[11] '^P'Best Message Posters');
  2463.        WriteLn(^R'[12] '^P'Worst Message Posters');
  2464.        WriteLn(^R'[13] '^P'Best Callers');
  2465.        WriteLn(^R'[14] '^P'Worst Callers');
  2466.        WriteLn(^R'[15] '^P'Show all Statistics');
  2467.        WriteStr(^M^P'Selection:');
  2468.        If Input='' then Input:='0';
  2469.        X1:=Valu(Input);
  2470.        Case X1 of
  2471.          1:ShowSomething(GoodUls,'Top 10 Uploaders',0);
  2472.          2:ShowSomething(BadUls,'Lowest 10 Uploaders',0);
  2473.          3:ShowSomething(GoodDls,'Top 10 Downloaders',0);
  2474.          4:ShowSomething(BadDls,'Lowest 10 Downloaders',0);
  2475.          5:ShowSomething(Posters,'Top 10 Post/Call Ratios',1);
  2476.          6:ShowSomething(LamePosters,'Lowest 10 Post/Call Ratios',1);
  2477.          7:ShowSomething(Uploaders,'Top 10 Uploaders in K-Bytes',2);
  2478.          8:ShowSomething(LameUploaders,'Lowest 10 Uploaders in K-Bytes',2);
  2479.          9:ShowSomething(Downloaders,'Top 10 Downloaders in K-Bytes',2);
  2480.          10:ShowSomething(LameDownloaders,'Lowest 10 Downloaders in K-Bytes',2);
  2481.          11:ShowSomething(GoodPosts,'Top 10 Message Posters',0);
  2482.          12:ShowSomething(BadPosts,'Lowest 10 Message Posters',0);
  2483.          13:ShowSomething(GoodCalls,'Top 10 Callers',0);
  2484.          14:ShowSomething(BadCalls,'Lowest 10 Callers',0);
  2485.          15:Begin
  2486.             ShowSomething(GoodUls,'Top 10 Uploaders',0);
  2487.             ShowSomething(BadUls,'Lowest 10 Uploaders',0);
  2488.             ShowSomething(GoodDls,'Top 10 Downloaders',0);
  2489.             ShowSomething(BadDls,'Lowest 10 Downloaders',0);
  2490.             ShowSomething(Posters,'Top 10 Post/Call Ratios',1);
  2491.             ShowSomething(LamePosters,'Lowest 10 Post/Call Ratios',1);
  2492.             ShowSomething(Uploaders,'Top 10 Uploaders in K-Bytes',2);
  2493.             ShowSomething(LameUploaders,'Lowest 10 Uploaders in K-Bytes',2);
  2494.             ShowSomething(Downloaders,'Top 10 Downloaders in K-Bytes',2);
  2495.             ShowSomething(LameDownloaders,'Lowest 10 Downloaders in K-Bytes',2);
  2496.             ShowSomething(GoodPosts,'Top 10 Message Posters',0);
  2497.             ShowSomething(BadPosts,'Lowest 10 Message Posters',0);
  2498.             ShowSomething(GoodCalls,'Top 10 Callers',0);
  2499.             ShowSomething(BadCalls,'Lowest 10 Callers',0);
  2500.          End;
  2501.        End;
  2502.      Until HungUpOn or (X1=0);
  2503.      End;
  2504.      If eatshit=1 then begin
  2505.      Initit(1);
  2506.       VizWay(GoodPosts,'Top 5 Message Posters',0,'Posts');
  2507.       Vizway(BadPosts,'Lowest 5 Message Posters',0,'Posts');
  2508.       WriteStr(^M^R'Press '^S'['^P'Enter'^S']:*');
  2509.      End;
  2510.      If eatshit=2 then Begin
  2511.      Initit(2);
  2512.       VizWay(Uploaders,'5 Best Uploaders',2,'Uploaded');
  2513.       Vizway(Downloaders,'5 Biggest Leeches',2,'Downloaded');
  2514.       WriteStr(^M^R'Press '^S'['^P'Enter'^S']:*');
  2515.      end;
  2516.    end;
  2517.  
  2518. Procedure DisplayNodeInfo;
  2519. Var T:Text;
  2520.     I:Integer;
  2521.     Done:Boolean;
  2522.     Ls:Lstr;
  2523. Begin
  2524.   if not configset.multinodebbs then exit;
  2525.   I:=0;
  2526.   ClearScr;
  2527.   WriteHdr('Who''s Online Right Now');
  2528.   Repeat
  2529.     Inc(I);
  2530.     Done:=Not Exist(ConfigSet.ForumDi+'NDST'+STRR(I));
  2531.     If Not Done then
  2532.       Begin
  2533.       Assign(T,ConfigSet.ForumDi+'NDST'+STrr(I));
  2534.       ReSet(T);
  2535.       ReadLn(T,Ls);
  2536.       TextClose(T);
  2537.       WriteLn(^S'[',I,'] '^R,Ls);
  2538.     End;
  2539.   Until Done;
  2540. End;
  2541.  
  2542. procedure get_infoform;
  2543. var empty:boolean;
  2544.  
  2545.   procedure listavailable;
  2546.   var cnt,num:integer;
  2547.       f:file;
  2548.   begin
  2549.     num:=0;
  2550.     for cnt:=1 to 5 do
  2551.      if (length(configset.inf[cnt]) > 0) and (not match(configset.inf[cnt],'UNUSED')) then begin
  2552.        If exist(configset.textfiledi+'INFOFORM.'+strr(cnt)) then Begin
  2553.          num:=num + 1;
  2554.          if num = 1 then writehdr ('Available Infoforms');
  2555.          tab (^R'['^U+strr(cnt)+^R'] '^P+configset.inf[cnt],34);
  2556.          case cnt of
  2557.           1:if (configset.iman[cnt]) and (urec.infoform  < 0) then
  2558.              write (^S'Required');
  2559.           2:if (configset.iman[cnt]) and (urec.infoform2 < 0) then
  2560.              write (^S'Required');
  2561.           3:if (configset.iman[cnt]) and (urec.infoform3 < 0) then
  2562.              write (^S'Required');
  2563.           4:if (configset.iman[cnt]) and (urec.infoform4 < 0) then
  2564.              write (^S'Required');
  2565.           5:if (configset.iman[cnt]) and (urec.infoform5 < 0) then
  2566.              write (^S'Required');
  2567.          end;
  2568.          writeln;
  2569.        end;
  2570.      end;
  2571.   end;
  2572.  
  2573.   function anyneeded:boolean;
  2574.   var cnt,locate,num:integer;
  2575.       f:file;
  2576.   begin
  2577.     empty:=false;
  2578.     anyneeded:=true;
  2579.     num:=0;
  2580.     close (f);
  2581.     for cnt:=1 to 5 do
  2582.        if (length(configset.inf[cnt]) > 0) then begin
  2583.        if exist(configset.textfiledi+'INFOFORM.'+strr(cnt)) then begin
  2584.          num:=9;
  2585.          if (configset.iman[cnt]) then begin
  2586.            case cnt of
  2587.             1:locate:=urec.infoform;
  2588.             2:locate:=urec.infoform2;
  2589.             3:locate:=urec.infoform3;
  2590.             4:locate:=urec.infoform4;
  2591.             5:locate:=urec.infoform5;
  2592.            end;
  2593.            if locate < 0 then exit;
  2594.          end;
  2595.        end;
  2596.      end;
  2597.     empty:=num < 1;
  2598.     anyneeded:=false;
  2599.   end;
  2600.  
  2601. var boo:boolean;
  2602.     s:string;
  2603. begin
  2604.   if configset.totform < 1 then exit;
  2605.   if ansigraphics in urec.config then
  2606.    write (#27'[J') else
  2607.   write (^L);
  2608.   boo:=anyneeded;
  2609.   repeat
  2610.    if empty then begin
  2611.      writeln ('Sorry, No Infoforms Available');
  2612.      exit;
  2613.    end;
  2614.    listavailable;
  2615.    if not boo then
  2616.     writestr (^M'Select Infoform to Fill Out [1..5][CR/Quit]:') else
  2617.    writestr (^M'Select Infoform to Fill Out [1..5]:');
  2618.    s:=input;
  2619.    if (valu(s) > 0) and (valu(s) < 6) then begin
  2620.      infoform (valu(s));
  2621.      boo:=anyneeded;
  2622.    end;
  2623.   until (valu(s)<1) and (boo = false);
  2624. end;
  2625.  
  2626. Procedure Usercheck;
  2627. Begin
  2628. if not (urec.use1) and not (urec.use2) and not (urec.use3) and not (urec.use4) and
  2629.     not (urec.use5) and not (urec.use6) and not (urec.use7) and not (urec.use8) then
  2630.     UserFileListing;
  2631.     topten(2);
  2632. End;
  2633.  
  2634. begin
  2635. end.
  2636.  
  2637.